302 lines
8.2 KiB
QBasic
302 lines
8.2 KiB
QBasic
Attribute VB_Name = "Module1"
|
|
Option Explicit
|
|
|
|
'共通変数
|
|
Public 事業計画テーブルID As String
|
|
Public apiKey As String
|
|
Public baseURL As String
|
|
Public 年度 As String
|
|
|
|
Public エクスポート1 As String
|
|
Public エクスポート2 As String
|
|
|
|
'処理開始
|
|
Sub run()
|
|
Debug.Print "------ START ------"
|
|
'実行確認
|
|
Dim rc As VbMsgBoxResult
|
|
rc = MsgBox("プリザンターから最新の事業計画データを取得しますか？" & Chr(13) & "この処理には少々時間が掛かります", vbYesNo + vbQuestion)
|
|
|
|
If rc = vbYes Then
|
|
Worksheets("実行度合表集計").Cells(1, 9) = "取得処理中..."
|
|
Application.ScreenUpdating = False '画面更新停止
|
|
Application.Calculation = xlManual '自動計算停止
|
|
|
|
'初期化
|
|
Call init
|
|
|
|
'事業計画データ取得１
|
|
Dim resCSV As Variant
|
|
resCSV = 事業計画CSVエクスポート(エクスポート1 & "")
|
|
'CSVデータをシートに保存
|
|
Call CSVデータ保存1(resCSV, 事業計画テーブルID & "")
|
|
|
|
'事業計画データ取得２
|
|
resCSV = 事業計画CSVエクスポート(エクスポート2 & "")
|
|
'CSVデータをシートに保存
|
|
Call CSVデータ保存2(resCSV)
|
|
|
|
'Worksheets("実行度合表集計").Range("B2").Select
|
|
Worksheets("実行度合表集計").Cells(1, 9) = "取得完了"
|
|
|
|
Application.Calculation = xlAutomatic '自動計算開始
|
|
Application.ScreenUpdating = True '画面更新開始
|
|
Else
|
|
MsgBox "処理を中止します", vbCritical
|
|
|
|
End If
|
|
|
|
Debug.Print "------ "
|
|
Debug.Print "------ END ------"
|
|
|
|
End Sub
|
|
|
|
Function init()
|
|
'パブリック変数に値を格納
|
|
'事業計画テーブル 214737
|
|
事業計画テーブルID = Range("事業計画テーブルID").Value
|
|
年度 = Range("年度").Value
|
|
エクスポート1 = Range("エクスポート1").Value
|
|
エクスポート2 = Range("エクスポート2").Value
|
|
|
|
'Pleasanter API KEY
|
|
apiKey = "6504c8a807677a3a576e10327f3c19876c55736ee45d4a845796b9e7f5e087bfd4bd0d8184863da8cf1733ca635111432ab334aea59102b06a96ee6d2c05190d"
|
|
baseURL = "https://nextoffice.Next-hd.co.jp"
|
|
|
|
End Function
|
|
|
|
Function 事業計画CSVエクスポート(exportId As String) As Variant
|
|
'共通変数
|
|
Dim apiUrl As String
|
|
Dim apiUrlParam As String
|
|
|
|
'リクエストURL
|
|
apiUrl = baseURL & "/pleasanter/api/items/" & 事業計画テーブルID & "/"
|
|
apiUrlParam = "export"
|
|
|
|
'ヘッダ
|
|
Dim apiHeaders As New Dictionary
|
|
apiHeaders.Add "Content-Type", "application/json;charset=utf-8"
|
|
|
|
'リクエストデータ
|
|
Dim apiBody As New Dictionary
|
|
apiBody.Add "ApiVersion", "1.1"
|
|
apiBody.Add "ApiKey", apiKey
|
|
apiBody.Add "ExportId", exportId
|
|
|
|
'Filter変数
|
|
Dim colFilter As New Dictionary
|
|
colFilter.Add "ClassZ", "[" & 年度 & "]"
|
|
|
|
'ソート指定
|
|
Dim colSorter As New Dictionary
|
|
colSorter.Add "Num199", "asc"
|
|
colSorter.Add "ClassA", "asc"
|
|
colSorter.Add "ClassB", "asc"
|
|
|
|
'View変数
|
|
Dim view As New Dictionary
|
|
view.Add "ColumnFilterHash", colFilter
|
|
view.Add "ColumnSorterHash", colSorter
|
|
apiBody.Add "View", view
|
|
|
|
'HTTPリクエスト送信メソッド呼び出し
|
|
Dim res As Object
|
|
Set res = callRestApi("POST", apiUrl, apiUrlParam, apiHeaders, apiBody)
|
|
|
|
If res("StatusCode") = 200 Then
|
|
Debug.Print "---- CSVデータの取得に成功しました"
|
|
事業計画CSVエクスポート = res("Response")("Content")
|
|
|
|
End If
|
|
|
|
End Function
|
|
|
|
Function CSVデータ保存1(csvData As Variant, targetSheet As String)
|
|
Debug.Print "------ CSVデータをシートに出力開始"
|
|
'CSVデータを「テーブル」部分に出力する処理
|
|
Dim ws As Worksheet
|
|
Set ws = ThisWorkbook.Sheets(targetSheet & "")
|
|
ws.Cells.ClearContents
|
|
|
|
Dim lines() As String
|
|
lines = Split(csvData, vbCrLf)
|
|
|
|
Dim i As Long, j As Long
|
|
Dim maxCols As Long
|
|
Dim values() As String
|
|
Dim arr() As Variant
|
|
|
|
'まず最大列数を取得
|
|
For i = LBound(lines) To UBound(lines)
|
|
If Trim(lines(i)) <> "" Then
|
|
values = Split(lines(i), ",")
|
|
If UBound(values) + 1 > maxCols Then
|
|
maxCols = UBound(values) + 1
|
|
End If
|
|
End If
|
|
Next i
|
|
|
|
'二次元配列を初期化
|
|
ReDim arr(0 To UBound(lines), 0 To maxCols - 1)
|
|
|
|
'配列に格納
|
|
For i = LBound(lines) To UBound(lines)
|
|
If Trim(lines(i)) <> "" Then
|
|
values = Split(lines(i), ",")
|
|
For j = LBound(values) To UBound(values)
|
|
arr(i, j) = values(j)
|
|
Next j
|
|
End If
|
|
Next i
|
|
|
|
'シートに出力
|
|
ws.Range(ws.Cells(1, 1), ws.Cells(UBound(arr, 1) + 1, UBound(arr, 2) + 1)).Value = arr
|
|
|
|
Debug.Print "------ "
|
|
Debug.Print "------ CSVデータをシートに出力完了"
|
|
End Function
|
|
|
|
|
|
|
|
Function CSVデータ保存2(csvData As Variant)
|
|
Debug.Print "------ CSVデータを店舗別シートに出力開始"
|
|
Dim lines() As String
|
|
lines = Split(csvData, vbCrLf)
|
|
|
|
Dim i As Long, j As Long
|
|
|
|
For i = LBound(lines) To UBound(lines)
|
|
If Trim(lines(i)) <> "" Then
|
|
Call シート作成処理(lines(i))
|
|
Call データシート保存(lines(i))
|
|
End If
|
|
Next i
|
|
|
|
|
|
Debug.Print "------ "
|
|
Debug.Print "------ CSVデータを店舗別シートに出力完了"
|
|
End Function
|
|
|
|
Function シート作成処理(data As String)
|
|
Dim values() As String
|
|
values = Split(data, vbTab)
|
|
|
|
Dim 店舗名 As String
|
|
店舗名 = values(1)
|
|
Dim 種別 As String
|
|
種別 = values(2)
|
|
|
|
'各シート存在確認
|
|
Dim 受着完シートExist As Boolean
|
|
Dim 損益シートExist As Boolean
|
|
Dim DATAシートExist As Boolean
|
|
|
|
受着完シートExist = シート確認(店舗名 & "_受着完")
|
|
損益シートExist = シート確認(店舗名 & "_損益")
|
|
DATAシートExist = シート確認(店舗名 & "_DATA")
|
|
|
|
'シート作成
|
|
If 受着完シートExist = False Then
|
|
If 種別 = "1" Then
|
|
Worksheets("受着完テンプレート2").Copy After:=Worksheets(Worksheets.count)
|
|
Else
|
|
Worksheets("受着完テンプレート1").Copy After:=Worksheets(Worksheets.count)
|
|
End If
|
|
|
|
ActiveSheet.Name = 店舗名 & "_受着完"
|
|
ActiveSheet.Range("A1") = 店舗名
|
|
If 種別 = "" Then
|
|
ActiveSheet.Range("A3") = "False"
|
|
Else
|
|
ActiveSheet.Range("A3") = "True"
|
|
End If
|
|
End If
|
|
|
|
If 損益シートExist = False Then
|
|
Worksheets("損益テンプレート").Copy After:=Worksheets(店舗名 & "_受着完")
|
|
ActiveSheet.Name = 店舗名 & "_損益"
|
|
ActiveSheet.Range("A1") = 店舗名
|
|
If 種別 = "" Then
|
|
ActiveSheet.Range("A3") = "False"
|
|
Else
|
|
ActiveSheet.Range("A3") = "True"
|
|
End If
|
|
End If
|
|
|
|
If DATAシートExist = False Then
|
|
Worksheets("DATAテンプレート").Copy After:=Worksheets(店舗名 & "_損益")
|
|
ActiveSheet.Name = 店舗名 & "_DATA"
|
|
'ActiveSheet.Visible = False
|
|
End If
|
|
|
|
|
|
End Function
|
|
|
|
Function データシート保存(data As String)
|
|
Dim values() As String
|
|
values = Split(data, vbTab)
|
|
|
|
Dim 店舗名 As String
|
|
店舗名 = values(1)
|
|
|
|
Dim ws As Worksheet
|
|
Set ws = ThisWorkbook.Sheets(店舗名 & "_DATA")
|
|
|
|
'シートをクリア
|
|
'ws.Visible = True
|
|
'ws.Select
|
|
ws.Range("C4:CG68").ClearContents
|
|
|
|
'データをシートに保存
|
|
Dim num As Long , i As Long, j As Long, x As Long, y As Long
|
|
Dim dataStr As String
|
|
Dim dataObj As Object
|
|
|
|
num = 3
|
|
Dim arrData() As Variant
|
|
ReDim arrData(1 To 65, 1 To 83)
|
|
|
|
x = 1
|
|
y = 1
|
|
|
|
For i = 1 To 6
|
|
For j = 1 To 12
|
|
dataStr = values(num)
|
|
Set dataObj = JsonConverter.ParseJson(dataStr)
|
|
|
|
Dim var, y1 As Long, x1 As Long
|
|
y1 = y
|
|
x1 = x
|
|
For Each var In dataObj
|
|
'Debug.Print "VAR1:" & var("1") , "VAR2:" & var("2") , "VAR3:" & var("3") , "VAR4:" & var("4") , "VAR6:" & var("6") , "VAR7:" & var("7")
|
|
arrData(x, y) = 日付変換(var("1"))
|
|
y = y + 1
|
|
arrData(x, y) = var("2")
|
|
y = y + 1
|
|
arrData(x, y) = var("3")
|
|
y = y + 1
|
|
arrData(x, y) = var("4")
|
|
y = y + 1
|
|
arrData(x, y) = var("6")
|
|
y = y + 1
|
|
arrData(x, y) = var("7")
|
|
y = y1
|
|
x = x + 1
|
|
Next var
|
|
y = y1 + 7
|
|
x = x1
|
|
num = num + 1
|
|
Next j
|
|
|
|
y = 1
|
|
x = x + 11
|
|
Next i
|
|
|
|
'データの書き込み
|
|
ws.Range("C4").Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData
|
|
'Debug.Print "---- " & 店舗名 & " のDATAシートにデータを保存します"
|
|
|
|
ws.Visible = False
|
|
End Function
|