mygit-admin/ken_nogi
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
4ff6e12165
ken_nogi/XVBA/MSS/■MSSツール/vba-files/Module/Module6.bas
Kenichiro NOGI 4ff6e12165 XVBA
2025-07-10 10:15:51 +09:00

391 lines
14 KiB
QBasic
Raw Blame History

Attribute VB_Name = "Module6"
Option Explicit
'粗利益確認書データインポート
Sub getArariDataTest()
Application.ScreenUpdating = False '画面更新停止
Application.Calculation = xlManual '自動計算停止
Call init
'Debug.Print ">>> 粗利益確認書のダウンロード 開始"
Dim resultId As String
resultId = Range("ResultId").value
If resultId <> "" Then
'Debug.Print resultId
Call getArariDataRequest(resultId)
End If
Application.Calculation = xlAutomatic '自動計算開始
Application.ScreenUpdating = True '画面更新開始
'Debug.Print "<<< 粗利益確認書のダウンロード 終了"
End Sub
'MSSマスターシートのIDを指定して、粗利益確認書のデータを取得する
Function getArariDataRequest(classA)
'共通変数
Dim apiUrl As String
Dim apiUrlParam As String
Dim tableId As String
'粗利益確認書テーブルID
tableId = "189113"
'リクエストURL
apiUrl = baseURL & "/pleasanter/api/items/" & tableId & "/"
apiUrlParam = "Get"
'ヘッダ
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
'Filter変数
Dim colFilter As New Dictionary
colFilter.Add "ClassA", "[" & classA & "]"
'View変数
Dim view As New Dictionary
view.Add "ColumnFilterHash", colFilter
apiBody.Add "View", view
'HTTPリクエスト送信メソッド呼び出し
Dim res As Object
Set res = callRestApi("POST", apiUrl, apiUrlParam, apiHeaders, apiBody)
'Debug.Print res("StatusCode")
'Debug.Print res("Response")("TotalCount")
If res("StatusCode") = 200 And res("Response")("TotalCount") = 1 Then
'グローバル変数へ情報格納
'Debug.Print res("StatusCode")
''Debug.Print res("Response")("TotalCount")
''Debug.Print res("Response")("Data")(1)("DescriptionHash")("DescriptionA")
'正常に取得できたらシートへ書き込み
'Debug.Print "粗利益確認書 取得成功"
Call exportArariData(res)
End If
End Function
'粗利益データをシートに出力する
Function exportArariData(res)
'Debug.Print "<< 粗利益確認書 出力開始"
Dim arariSh
'既存データのクリア
Set arariSh = Worksheets("粗利益確認書(本契約)")
arariSh.Range("F11:G11").ClearContents '本体金額
arariSh.Range("C12:G21").ClearContents '付帯工事
arariSh.Range("L24").ClearContents '利益率(%)
arariSh.Range("C25:I34").ClearContents '本体工事内上乗せ
arariSh.Range("C37:I46").ClearContents '確定付帯上乗せ
arariSh.Range("C49:I58").ClearContents 'サービス項目
arariSh.Range("G59:I59").ClearContents '紹介料
arariSh.Range("F60:G60").ClearContents '値引き
arariSh.Range("C63:I72").ClearContents 'その他工事
arariSh.Range("G80").ClearContents '積算チェック 追加変更
Set arariSh = Worksheets("粗利益確認書(設計契約)")
arariSh.Range("F11:G11").ClearContents '本体金額
arariSh.Range("C12:G21").ClearContents '付帯工事
arariSh.Range("L24").ClearContents '利益率(%)
arariSh.Range("C25:I34").ClearContents '本体工事内上乗せ
arariSh.Range("C37:I46").ClearContents '確定付帯上乗せ
arariSh.Range("C49:I58").ClearContents 'サービス項目
arariSh.Range("G59:I59").ClearContents '紹介料
arariSh.Range("F60:G60").ClearContents '値引き
arariSh.Range("C63:I72").ClearContents 'その他工事
arariSh.Range("G80").ClearContents '積算チェック 追加変更
'本契約粗利益確認書格納変数
Dim descA, descB, desc002, descD, descF, descH, descI, descJ, descL, desc008 As String
Dim descAdata, descBdata, desc002data, descDdata, descFdata, descHdata, descIdata, descJdata, descLdata, desc008data As Object
descA = res("Response")("Data")(1)("DescriptionHash")("DescriptionA") 'A.本体価格
descB = res("Response")("Data")(1)("DescriptionHash")("DescriptionB") 'B.付帯項目
desc002 = res("Response")("Data")(1)("DescriptionHash")("Description002") '002.中計1
descD = res("Response")("Data")(1)("DescriptionHash")("DescriptionD") 'D.本体工事内上乗せ
descF = res("Response")("Data")(1)("DescriptionHash")("DescriptionF") 'F.確定付帯工事
descH = res("Response")("Data")(1)("DescriptionHash")("DescriptionH") 'H.サービス項目
descI = res("Response")("Data")(1)("DescriptionHash")("DescriptionI") 'I.紹介料
descJ = res("Response")("Data")(1)("DescriptionHash")("DescriptionJ") 'J.サービス項目 値引き
descL = res("Response")("Data")(1)("DescriptionHash")("DescriptionL") 'L.その他工事
desc008 = res("Response")("Data")(1)("DescriptionHash")("Description008") '008.積算チェック
Set descAdata = JsonConverter.ParseJson(descA)
Set descBdata = JsonConverter.ParseJson(descB)
Set desc002data = JsonConverter.ParseJson(desc002)
Set descDdata = JsonConverter.ParseJson(descD)
Set descFdata = JsonConverter.ParseJson(descF)
Set descHdata = JsonConverter.ParseJson(descH)
Set descIdata = JsonConverter.ParseJson(descI)
Set descJdata = JsonConverter.ParseJson(descJ)
Set descLdata = JsonConverter.ParseJson(descL)
Set desc008data = JsonConverter.ParseJson(desc008)
Dim xx As Long
Dim value
'本契約粗利益確認書
Set arariSh = Worksheets("粗利益確認書(本契約)")
arariSh.Cells(1, 18) = res("Response")("Data")(1)("ResultId")
'------------------------------------------------------------
'本体金額
xx = 11
For Each value In descAdata
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
xx = xx + 1
Next value
'------------------------------------------------------------
'付帯工事
xx = 12
For Each value In descBdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
xx = xx + 1
If xx = 22 Then
Exit For
End If
Next value
'------------------------------------------------------------
'中計1 利益率
xx = 24
For Each value In desc002data
arariSh.Cells(xx, 12) = value("7")
xx = xx + 1
Next value
'------------------------------------------------------------
'本体工事内上乗せ
xx = 25
For Each value In descDdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
If xx = 35 Then
Exit For
End If
Next value
'------------------------------------------------------------
'確定付帯上乗せ
xx = 37
For Each value In descFdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
If xx = 47 Then
Exit For
End If
Next value
'------------------------------------------------------------
'サービス項目
xx = 49
For Each value In descHdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
If xx = 59 Then
Exit For
End If
Next value
'------------------------------------------------------------
'紹介料
xx = 59
For Each value In descIdata
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
Next value
'------------------------------------------------------------
'値引き
xx = 60
For Each value In descJdata
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
xx = xx + 1
Next value
'------------------------------------------------------------
'その他項目
xx = 63
For Each value In descLdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
If xx = 73 Then
Exit For
End If
Next value
'------------------------------------------------------------
'積算チェック
xx = 80
For Each value In desc008data
arariSh.Cells(xx, 7) = value("2")
xx = xx + 1
Next value
'------------------------------------------------------------
'設計契約粗利益確認書格納変数
Dim desc021, desc022, desc042, desc024, desc026, desc028, desc029, desc030, desc032, desc048 As String
desc021 = res("Response")("Data")(1)("DescriptionHash")("Description021") 'S_A.本体価格
desc022 = res("Response")("Data")(1)("DescriptionHash")("Description022") 'S_B.付帯項目
desc042 = res("Response")("Data")(1)("DescriptionHash")("Description042") '中計1
desc024 = res("Response")("Data")(1)("DescriptionHash")("Description024") 'S_D.本体工事内上乗せ
desc026 = res("Response")("Data")(1)("DescriptionHash")("Description026") 'S_F.確定付帯工事
desc028 = res("Response")("Data")(1)("DescriptionHash")("Description028") 'S_H.サービス項目
desc029 = res("Response")("Data")(1)("DescriptionHash")("Description029") 'S_I.紹介料
desc030 = res("Response")("Data")(1)("DescriptionHash")("Description030") 'S_J.サービス項目 値引き
desc032 = res("Response")("Data")(1)("DescriptionHash")("Description032") 'S_L.その他工事
desc048 = res("Response")("Data")(1)("DescriptionHash")("Description048") '048.積算チェック
Set descAdata = JsonConverter.ParseJson(desc021)
Set descBdata = JsonConverter.ParseJson(desc022)
Set desc002data = JsonConverter.ParseJson(desc042)
Set descDdata = JsonConverter.ParseJson(desc024)
Set descFdata = JsonConverter.ParseJson(desc026)
Set descHdata = JsonConverter.ParseJson(desc028)
Set descIdata = JsonConverter.ParseJson(desc029)
Set descJdata = JsonConverter.ParseJson(desc030)
Set descLdata = JsonConverter.ParseJson(desc032)
Set desc008data = JsonConverter.ParseJson(desc048)
'設計契約粗利益確認書
Set arariSh = Worksheets("粗利益確認書(設計契約)")
arariSh.Cells(1, 18) = res("Response")("Data")(1)("ResultId")
'------------------------------------------------------------
'本体金額
xx = 11
For Each value In descAdata
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
xx = xx + 1
Next value
'------------------------------------------------------------
'付帯工事
xx = 12
For Each value In descBdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
xx = xx + 1
If xx = 22 Then
Exit For
End If
Next value
'------------------------------------------------------------
'中計1 利益率
xx = 24
For Each value In desc002data
arariSh.Cells(xx, 12) = value("7")
xx = xx + 1
Next value
'------------------------------------------------------------
'本体工事内上乗せ
xx = 25
For Each value In descDdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
If xx = 35 Then
Exit For
End If
Next value
'------------------------------------------------------------
'確定付帯上乗せ
xx = 37
For Each value In descFdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
If xx = 47 Then
Exit For
End If
Next value
'------------------------------------------------------------
'サービス項目
xx = 49
For Each value In descHdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
If xx = 59 Then
Exit For
End If
Next value
'------------------------------------------------------------
'紹介料
xx = 59
For Each value In descIdata
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
Next value
'------------------------------------------------------------
'値引き
xx = 60
For Each value In descJdata
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
xx = xx + 1
Next value
'------------------------------------------------------------
'その他項目
xx = 63
For Each value In descLdata
arariSh.Cells(xx, 3) = value("0")
arariSh.Cells(xx, 6) = value("1")
arariSh.Cells(xx, 7) = value("2")
arariSh.Cells(xx, 8) = value("3")
arariSh.Cells(xx, 9) = value("4")
xx = xx + 1
If xx = 73 Then
Exit For
End If
Next value
'------------------------------------------------------------
'積算チェック
xx = 80
For Each value In desc008data
arariSh.Cells(xx, 7) = value("2")
xx = xx + 1
Next value
'------------------------------------------------------------
'Debug.Print "<< 粗利益確認書 出力完了"
End Function
Reference in New Issue View Git Blame Copy Permalink