kaz_javaSpringBootプログラム作成ツールのエクセルVBAをVBに変えてエクセルの外に出す。
■8：30
昨日は、エクセルマクロVBAをVB.netにするのをやめようって思った。けど、挑戦するなら難しいほうがやりがいがある。ので、
今日は、エクセルマクロVBAの実行時間と同じものを目指そう。といっても、昨日の夜発見した”VB.net用のPOIでエクセル操作が軽くて速い”って一文に沿ってみようということ。これでだめなら、あきらめよう。
①現時点（Excel.Application使用）の、「コードID一覧定義更新」関数を比較して、どんな変換したかのせておこう。エクセルマクロVBAが1秒なら、VB.netで30秒って感じの速度感。あと、ネットで調べて、ここまでやっと、エクセルプロセスが残らなくなる。と思ったら、Excel.ApplicationとExcel.WorkbookだけSystem.Runtime.InteropServices.Marshal.ReleaseComObject()するだけでエクセルプロセスが残らなくなる。←試してみたので確実。さらに、実行速度にはなんの影響はない。頑張ってReleaseComObjectする必要はなさそう。
①-1.エクセルマクロVBA：関数部分のみ抜粋
'コード一覧表から「★コードＩＤ一覧★」NAME定義を更新する。
' 当Subは「Worksheet_Activate」「Worksheet_Deactivate」イベントから呼ばれる。
' "★TOOL用コンスタント★"シートは非表示になっています。
Public Sub コードID一覧定義更新(DUMMY)
Dim Dst1 As Worksheet, Dst2 As Worksheet, Rng As Range
Dim x As Integer, y As Integer, i As Integer, j As Integer, index As Integer
Dim cx As Long, cy As Long
Dim valss, cnt, kuhakuCnt
Dim テーブルID達マップ As Object
Dim コード一覧表№, コードID, str_wk
コード一覧表№ = ""
コードID = ""
On Error GoTo コードID一覧定義更新ErrorHandler
Application.EnableEvents = False
Set Dst1 = Sheets("★TOOL用コンスタント★")
Set Rng = Dst1.Range("★コードＩＤ一覧★")
Set Dst2 = Sheets("コード一覧表")
i = 0
kuhakuCnt = 0
Set テーブルID達マップ = Nothing
Set テーブルID達マップ = CreateObject("Scripting.Dictionary")
Do While (Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表№列) <> "END") 'ENDになるまでループ
If Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列) <> "" Then
テーブルID達マップ.Add Trim(LCase(Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列))), _
Trim(LCase(Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列)))
Else
kuhakuCnt = kuhakuCnt + 1
If kuhakuCnt > 1000 Then
'MsgBox ("「コード一覧表」の№行の最後はENDにしてください。")
Exit Do
End If
End If
i = i + 1
Loop
i = 0
kuhakuCnt = 0
Do While (Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表№列) <> "END") 'ENDになるまでループ
If Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列) <> "" Then
If テーブルID達マップ.exists(Trim(LCase(Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)))) Then
MsgBox ("「コード一覧表」シートの「KEY項目ID」=""" & Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列) & """は" & _
"テーブルIDとして使用されています。" & vbCrLf & _
"強制的に「KEY項目ID」＋""_cd""に変更します。")
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列) = _
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列) & "_cd"
End If
Else
kuhakuCnt = kuhakuCnt + 1
If kuhakuCnt > 1000 Then
'MsgBox ("「コード一覧表」の№行の最後はENDにしてください。")
Exit Do
End If
End If
i = i + 1
Loop
Rng.ClearContents
cx = Rng.Columns.Count
cy = Rng.Rows.Count
x = Rng.Column
y = Rng.row
i = 0
cnt = 0
kuhakuCnt = 0
Do While (Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表№列) <> "END") 'ENDになるまでループ
If (Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表№列) <> "" And _
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードID列) <> "") Or _
(Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードselectなど列) <> "" And _
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列) <> "") Then
' コード一覧表コードID列が入っている時はエレメントと考える。
If Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードID列) <> "" Then
コード一覧表№ = Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表№列)
コードID = Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードID列)
' I列（大分類／中分類／小分類）が入っている時はDBデータからデータを取得する場合と考える。
If Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードselectなど列) <> "" And _
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列) <> "" Then
If Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード値列) = "" Then
If Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列) = "大分類" Then
If Left(コードID, Len("ary_lrgmidsml_")) <> "ary_lrgmidsml_" Then
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のB列（コードID）は「""ary_lrgmidsml_""大分類のテーブルID」にしてください。")
ElseIf Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列) <> Right(コードID, Len(コードID) - Len("ary_lrgmidsml_")) Then
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のB列（コードID）は「""ary_lrgmidsml_""大分類のテーブルID」にしてください。")
ElseIf Trim(Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)) = "" Or _
Trim(Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード分類名の項目ID列)) = "" Then
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のK列（テーブル略称）、L列（KEY項目ID）、M列（分類名の項目ID）を指定してください。")
Else
Dst1.Cells(y + cnt, x) = コード一覧表№ & "." & _
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードselectなど列) & "." & _
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列) & "." & _
コードID
End If
Else
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のI列（大分類／中分類／小分類）は大分類から記述してください。")
End If
Else
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のI列（大分類／中分類／小分類）を設定したときはD列（値）を設定しないでください。")
End If
Else
Dst1.Cells(y + cnt, x) = コード一覧表№ & "." & _
コードID
End If
' I列（大分類／中分類／小分類）が入っている時はDBデータからデータを取得、エレメントIDがある。
ElseIf Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列) <> "" And コード一覧表№ <> "" Then
str_wk = Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)
If str_wk = "大分類" Or str_wk = "中分類" Or str_wk = "小分類" Then
If (str_wk = "大分類") Or _
(str_wk = "中分類" And Dst2.Cells(constコード一覧表開始行 + i - 1, constコード一覧表コード大中小分類列) <> "大分類") Or _
(str_wk = "小分類" And Dst2.Cells(constコード一覧表開始行 + i - 2, constコード一覧表コード大中小分類列) <> "中分類") Then
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のI列（大分類／中分類／小分類）は。「大分類」「中分類」「小分類」の順に記述してください。")
ElseIf (str_wk = "中分類" Or str_wk = "小分類") And Trim(Dst2.Cells(constコード一覧表開始行 + i + 1, constコード一覧表コードKEY項目ID列)) = "" Then
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i + 1) & "行目：「コード一覧表」のL列（KEY項目ID)を指定してください。")
ElseIf str_wk = "小分類" And Trim(Dst2.Cells(constコード一覧表開始行 + i + 2, constコード一覧表コードKEY項目ID列)) = "" Then
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i + 2) & "行目：「コード一覧表」のL列（KEY項目ID)を指定してください。")
Else
Dst1.Cells(y + cnt, x) = コード一覧表№ & "." & _
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コードselectなど列) & "." & _
Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列) & "." & _
コードID
End If
Else
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のI列（大分類／中分類／小分類）は。「大分類」「中分類」「小分類」のいずれかにしてください。")
End If
' I列（大分類／中分類／小分類）が入っている時はDBデータからデータを取得、エレメントIDがない。
ElseIf Dst2.Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列) <> "" And コード一覧表№ = "" Then
MsgBox ("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のI列（大分類／中分類／小分類）のためのコードIDが指定されていないみたいです。")
Else
コード一覧表№ = ""
コードID = ""
End If
cnt = cnt + 1
kuhakuCnt = 0
Else
kuhakuCnt = kuhakuCnt + 1
If kuhakuCnt > 1000 Then
'MsgBox ("「コード一覧表」の№行の最後はENDにしてください。")
Exit Do
End If
End If
i = i + 1
Loop
If i = 0 Then
ActiveWorkbook.Names.Add Name:="★コードＩＤ一覧★", RefersToR1C1:= _
"=★TOOL用コンスタント★!R" & y & "C" & x & ":R" & y & "C" & x
Else
ActiveWorkbook.Names.Add Name:="★コードＩＤ一覧★", RefersToR1C1:= _
"=★TOOL用コンスタント★!R" & y & "C" & x & ":R" & (y + cnt - 1) & "C" & x
End If
コードID一覧定義更新ErrorHandler:
Application.EnableEvents = True
End Sub①-2.VB.net：関数部分のみ抜粋
Private Sub CodeListUpdBtn_Click(sender As Object, e As EventArgs) Handles CodeListUpdBtn.Click
Dim oXL As Excel.Application
' Dim oBooks As Excel.Workbooks
Dim oWB As Excel.Workbook
Dim oSheets As Excel.Sheets
Dim oSheet As Excel.Worksheet
Try
If InStr(System.IO.Path.GetFileName(ExcelName.Text), ".xlsx") = 0 Then
MsgBox("エクセル名を指定してください。")
Else
oXL = CreateObject("Excel.Application")
MsgBox(System.IO.Path.GetFileName(ExcelName.Text) & "に対して" & vbCrLf & "処理(書換え含む)されます。" & vbCrLf &
"★★★ちょっと時間がかかります。★★★" & vbCrLf &
"実行結果は画面メッセージ及び、同フォルダ「チェック結果メッセージ.tx」に" & vbCrLf & "追加出力されます。" & vbCrLf &
"終了すると「///---コードID一覧定義更新処理が終了しました。---///」が表示されます。")
oXL.Visible = False
'ファイルオープン
oWB = oXL.Workbooks.Open(ExcelName.Text)
'MsgBox(oWB.Name)
If oWB.ReadOnly Then
MsgBox("エラー：指定のエクセル名のファイルはすでに開かれています。閉じてください。" & vbCrLf &
"もしもほかに開いていないのにメッセージが出る場合、当PGMの例外発生時にMicrosoftExcelプロセスが残ってしまった可能性が考えられます。" & vbCrLf &
"当PGMを終了し、全てのエクセルを閉じた後で、タスクマネージャを開いてプロセスからMicrosoftExcelを削除して、再度当PGMを実行してみてください。", vbCritical)
Else
'oXL.Visible = True
oSheets = oWB.Worksheets
コードID一覧定義更新(oXL, oWB, oSheets, System.IO.Path.GetDirectoryName(ExcelName.Text))
End If
End If
Catch ex As Exception
MessageBox.Show("システムエラーが発生しました。" & ex.Message & vbCrLf & ex.StackTrace())
Finally
'COMコンポーネントの解放
CloseXls(oSheet)
CloseXls(oSheets)
If Not oWB Is Nothing Then
oWB.Save()
oWB.Close()
CloseXls(oWB)
End If
If Not oXL Is Nothing Then
oXL.Quit()
CloseXls(oXL)
End If
End Try
End Sub 'コード一覧表から「★コードＩＤ一覧★」NAME定義を更新する。
Public Sub コードID一覧定義更新(oXL As Excel.Application, oWB As Excel.Workbook, oSheets As Excel.Sheets, DirectoryName As String)
Dim Dst1 As Excel.Worksheet, Dst2 As Excel.Worksheet, Rng As Excel.Range
Dim Dst1Cells As Excel.Range, Dst2Cells As Excel.Range
Dim x As Integer, y As Integer, i As Integer, j As Integer, index As Integer
Dim cx As Long, cy As Long
Dim cnt
Dim テーブルID達マップ As New Dictionary(Of String, String)()
Dim RngStack As New Stack(Of Excel.Range)()
Dim RngStackForSet As New Stack(Of Excel.Range)()
Dim コード一覧表NO As String, コードID As String, str_wk As String
Dim コード一覧表コード値列Val As String
Dim コード一覧表コードテーブルID列Val As String
Dim コード一覧表コードKEY項目ID列Val As String
System.Text.Encoding.RegisterProvider(System.Text.CodePagesEncodingProvider.Instance)
Dim sw As System.IO.StreamWriter
Try
sw = New System.IO.StreamWriter(DirectoryName & "\チェック結果メッセージ.txt", True, System.Text.Encoding.GetEncoding("shift_jis"))
Catch ex As Exception
MsgBox(DirectoryName & "\チェック結果メッセージ.txtを開くことが出来ませんでした。")
Return
Finally
End Try
Try
sw.WriteLine(vbCrLf & "■＝＝＝＝<<" & DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss") & " コードID一覧定義更チェック結果>>＝＝＝＝")
コード一覧表NO = ""
コードID = ""
Dst1 = oSheets("★TOOL用コンスタント★")
Rng = Dst1.Range("★コードＩＤ一覧★")
Dst2 = oSheets("コード一覧表")
Dst2.Activate()
'oXL.EnableEvents = False
Dst1Cells = Dst1.Cells
Dst2Cells = Dst2.Cells
i = 0
コード一覧表コード値列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード値列)).Text.ToString
コード一覧表コードテーブルID列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列)).Text.ToString
コード一覧表コードKEY項目ID列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)).Text.ToString
Do While コード一覧表コード値列Val <> "" Or コード一覧表コードKEY項目ID列Val <> "" '値または、Key項目IDが入っている
If コード一覧表コードテーブルID列Val <> "" Then
'MsgAndFile(コード一覧表コードテーブルID列Val, sw)
If Not テーブルID達マップ.ContainsKey(Strings.Trim(LCase(コード一覧表コードテーブルID列Val))) Then
テーブルID達マップ.Add(Strings.Trim(LCase(コード一覧表コードテーブルID列Val)),
Strings.Trim(LCase(コード一覧表コードテーブルID列Val)))
End If
End If
i += 1
コード一覧表コード値列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード値列)).Text.ToString
コード一覧表コードテーブルID列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列)).Text.ToString
コード一覧表コードKEY項目ID列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)).Text.ToString
Loop
i = 0
コード一覧表コード値列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード値列)).Text.ToString
コード一覧表コードテーブルID列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列)).Text.ToString
コード一覧表コードKEY項目ID列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)).Text.ToString
Do While コード一覧表コード値列Val <> "" Or コード一覧表コードKEY項目ID列Val <> "" '値または、Key項目IDが入っている
If コード一覧表コードKEY項目ID列Val <> "" Then
If テーブルID達マップ.ContainsKey(Strings.Trim(LCase(コード一覧表コードKEY項目ID列Val))) Then
MsgAndFile("「コード一覧表」シートの「KEY項目ID」=""" & コード一覧表コードKEY項目ID列Val & """は" &
"テーブルIDとして使用されています。" & vbCrLf &
"強制的に「KEY項目ID」＋""_cd""に変更します。", sw)
RngStackFunc(RngStackForSet, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)).Value =
コード一覧表コードKEY項目ID列Val & "_cd"
End If
End If
i += 1
コード一覧表コード値列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード値列)).Text.ToString
コード一覧表コードテーブルID列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列)).Text.ToString
コード一覧表コードKEY項目ID列Val = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)).Text.ToString
Loop
Rng.ClearContents()
cx = Rng.Columns.Count
cy = Rng.Rows.Count
x = Rng.Column
y = Rng.Row
i = 0
cnt = 0
Do While RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード値列)).Text.ToString <> "" Or
RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)).Text.ToString <> "" '値または、Key項目IDが入っている
If (RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表NO列)).Text.ToString <> "" And
RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードID列)).Text.ToString <> "") Or
(RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードselectなど列)).Text.ToString <> "" And
RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)).Text.ToString <> "") Then
' コード一覧表コードID列が入っている時はエレメントと考える。
If RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードID列)).Text.ToString <> "" Then
コード一覧表NO = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表NO列)).Text.ToString
コードID = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードID列)).Text.ToString
' I列（大分類／中分類／小分類）が入っている時はDBデータからデータを取得する場合と考える。
If RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードselectなど列)).Text.ToString <> "" And
RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)).Text.ToString <> "" Then
If RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード値列)).Text.ToString = "" Then
If RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)).Text.ToString = "大分類" Then
If Strings.Left(コードID, Len("ary_lrgmidsml_")) <> "ary_lrgmidsml_" Then
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のB列（コードID）は「""ary_lrgmidsml_""大分類のテーブルID」にしてください。", sw)
ElseIf RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードテーブルID列)).Text.ToString <> Strings.Right(コードID, Len(コードID) - Len("ary_lrgmidsml_")) Then
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のB列（コードID）は「""ary_lrgmidsml_""大分類のテーブルID」にしてください。", sw)
ElseIf Strings.Trim(RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードKEY項目ID列)).Text.ToString) = "" Or
Strings.Trim(RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード分類名の項目ID列)).Text.ToString) = "" Then
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のJ列（KEY項目ID）、K列（分類名の項目ID）を指定してください。", sw)
Else
RngStackFunc(RngStackForSet, Dst1Cells(y + cnt, x)).Value = コード一覧表NO & "." &
RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードselectなど列)).Text.ToString & "." &
RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)).Text.ToString & "." &
コードID
End If
Else
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のG列（大分類／中分類／小分類）は大分類から記述してください。", sw)
End If
Else
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のG列（大分類／中分類／小分類）を設定したときはD列（値）を設定しないでください。", sw)
End If
Else
RngStackFunc(RngStackForSet, Dst1Cells(y + cnt, x)).Value = コード一覧表NO & "." &
コードID
End If
' I列（大分類／中分類／小分類）が入っている時はDBデータからデータを取得、エレメントIDがある。
ElseIf RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)).Text.ToString <> "" And コード一覧表NO <> "" Then
str_wk = RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)).Text.ToString
If str_wk = "大分類" Or str_wk = "中分類" Or str_wk = "小分類" Then
If (str_wk = "大分類") Or
(str_wk = "中分類" And RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i - 1, constコード一覧表コード大中小分類列)).Text.ToString <> "大分類") Or
(str_wk = "小分類" And RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i - 2, constコード一覧表コード大中小分類列)).Text.ToString <> "中分類") Then
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のG列（大分類／中分類／小分類）は「大分類」「中分類」「小分類」の順に記述してください。" & vbCrLf &
"「大分類」は主キー１つ、「中分類」は主キー２つ、「小分類」は主キー３つ、主キー数固定です。", sw)
ElseIf (str_wk = "中分類" Or str_wk = "小分類") And Strings.Trim(RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i + 1, constコード一覧表コードKEY項目ID列)).Text.ToString) = "" Then
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i + 1) & "行目：「コード一覧表」のJ列（KEY項目ID)を指定してください。", sw)
ElseIf str_wk = "小分類" And Strings.Trim(RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i + 2, constコード一覧表コードKEY項目ID列)).Text.ToString) = "" Then
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i + 2) & "行目：「コード一覧表」のJ列（KEY項目ID)を指定してください。", sw)
Else
RngStackFunc(RngStackForSet, Dst1Cells(y + cnt, x)).Value = コード一覧表NO & "." &
RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コードselectなど列)).Text.ToString & "." &
RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)).Text.ToString & "." &
コードID
End If
Else
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のG列（大分類／中分類／小分類）は「大分類」「中分類」「小分類」のいずれかにしてください。", sw)
End If
' I列（大分類／中分類／小分類）が入っている時はDBデータからデータを取得、エレメントIDがない。
ElseIf RngStackFunc(RngStack, Dst2Cells(constコード一覧表開始行 + i, constコード一覧表コード大中小分類列)).Text.ToString <> "" And コード一覧表NO = "" Then
MsgAndFile("「コード一覧表」の" & (constコード一覧表開始行 + i) & "行目：「コード一覧表」のG列（大分類／中分類／小分類）のためのコードIDが指定されていないみたいです。", sw)
Else
コード一覧表NO = ""
コードID = ""
End If
cnt += 1
End If
i += 1
Loop
If i = 0 Then
oXL.ActiveWorkbook.Names.Add("★コードＩＤ一覧★",
"=★TOOL用コンスタント★!R" & y & "C" & x & ":R" & y & "C" & x)
Else
oXL.ActiveWorkbook.Names.Add("★コードＩＤ一覧★",
"=★TOOL用コンスタント★!R" & y & "C" & x & ":R" & (y + cnt - 1) & "C" & x)
End If
MsgAndFile("///---コードID一覧定義更新処理が終了しました。---///" & vbCrLf & (constコード一覧表開始行 + i) &
"行目のC列、J列が空なので以降行はチェックしていません。OKですか？" & vbCrLf &
"NGならC列、J列どちらかに値を入れて当チェックをしてください。" & vbCrLf &
"★★★重要：エクセルは書き換えがあれば書き換わっています！！★★★" &
vbCrLf & "「チェック結果メッセージ.txt」を確認し、途中、エラーや内容変更メッセージが" & vbCrLf &
"表示された場合、エラー修正や変更確認後再度ボタンを押下してください。" &
vbCrLf & "途中、エラーや内容変更メッセージがなくなるまで当チェックを繰り返してください。！", sw)
Catch ex As Exception
sw.WriteLine("エラー発生: " & ex.Message & vbCrLf & ex.StackTrace() & vbcrlf)
'呼び元でエラーメッセージを表示するため例外を再スローする
Throw
Finally
テーブルID達マップ = Nothing
oXL.EnableEvents = True
sw.Close()
'COMコンポーネントの解放
RngStackCloseFunc(RngStack)
RngStackCloseFunc(RngStackForSet)
CloseXls(Dst1Cells)
CloseXls(Dst2Cells)
CloseXls(Rng)
CloseXls(Dst1)
CloseXls(Dst2)
End Try
End Sub Private Function RngStackFunc(s As Stack(Of Excel.Range), Rng As Excel.Range) As Excel.Range
Dim RtnRng As Excel.Range
'なぜかExcel.Range.Valueに値を入れるものは、途中でCloseXls(s.Pop())すると、 CloseXls(Dst2)後に、
'例外（COM object that has been separated from its underlying RCW cannot be used.）発生するのでCloseXls(s.Pop())しない。
s.Push(Rng)
RtnRng = DirectCast(Rng, Excel.Range)
s.Push(RtnRng)
Return RtnRng
End Function Private Sub RngStackCloseFunc(s As Stack(Of Excel.Range))
'全てとりだし
Do While s.Count > 0
CloseXls(s.Pop())
Loop
End Sub Public Sub MsgAndFile(msg As String, sw As System.IO.StreamWriter)
MsgBox(msg)
sw.WriteLine(msg)
End Sub Public Sub MsgAndFileOnCells(SheetName As String, xlRange As Excel.Range, msg As String, sw As System.IO.StreamWriter)
Dim str As String
If xlRange Is Nothing Then
str = "「" & SheetName & "」シート：" & msg
Else
str = "「" & SheetName & "」シート" & xlRange.Row & "行" & xlRange.Column & "列：" & msg
End If
MsgBox(str)
sw.WriteLine(str)
End Sub
Private Sub CloseXls(ByRef objCom As Object)
'COM オブジェクトの使用後、明示的に COM オブジェクトへの参照を解放する
Try
'提供されたランタイム呼び出し可能ラッパーの参照カウントをデクリメントします
If Not objCom Is Nothing AndAlso System.Runtime.InteropServices.
Marshal.IsComObject(objCom) Then
Dim I As Integer
Do
I = System.Runtime.InteropServices.Marshal.ReleaseComObject(objCom)
Loop Until I <= 0
End If
Catch
Finally
'参照を解除する
objCom = Nothing
End Try
End Sub■2021/06/21から、『kaz_javaSpringBootプログラム自動作成◎自動生成ツール』をVectorに載せています。2022年にZenn本も書きました。使ってみての感想や間違いの指定や、こうやったほうがいいとかの情報があればメールください。
・Vector
www.vector.co.jp
・Zenn本(SpringBoot、Thymeleaf プログラム自動作成（マクロ使用版）)
zenn.dev
