人がExcel VBA (VisualBasic for Applications) の学習をしているのだが、無意味にその教科書のcodeを綺麗にする等していた。ちなみにその教科書のcodeがあんまり綺麗でないのは、故有る事で、あんまり初歩だから、既に読者が「習つた」内容で書くと仕方がなく、教科書の著者の所為ではない。
つまり私は無駄な事をした。VBAを弄るのは初めてである。
元のcode
Sub 請求書作成() Set WS1 = Worksheets("sheet1") Set WS2 = Worksheets("sheet2") Set WS3 = Worksheets("sheet3") WS3.Copy after:=WS3 With ActiveSheet .Name = WS1.Range("B4") & "請求書" .Range("B6") = WS1.Range("B4") & " " & WS1.Range("C4") .Range("C9") = WS1.Range("A1") .Range("E9") = WS1.Range("B4") .Range("F4") = Date .Range("B2") = "請求者番号: " & WS1.Range("A4") .Tab.ColorIndex = 6 End With WS3.Copy after:=ActiveSheet With ActiveSheet .Name = WS1.Range("B5") & "請求書" .Range("B6") = WS1.Range("B5") & " " & WS1.Range("C5") .Range("C9") = WS1.Range("A1") .Range("E9") = WS1.Range("B5") .Range("F4") = Date .Range("B2") = "請求者番号: " & WS1.Range("A5") .Tab.ColorIndex = 8 End With WS3.Copy after:=ActiveSheet With ActiveSheet .Name = WS1.Range("B6") & "請求書" .Range("B6") = WS1.Range("B6") & " " & WS1.Range("C6") .Range("C9") = WS1.Range("A1") .Range("E9") = WS1.Range("B6") .Range("F4") = Date .Range("B2") = "請求者番号: " & WS1.Range("A6") .Tab.ColorIndex = 4 End With End Sub
私が弄ったcode
エラーチェックを足す序でに、いろいろ弄った。メインの変更箇所は、既に同名のsheetが存在した場合、ユーザに確認する様にしたことである。
Type Vendor Name As String Code As String PersonName As String End Type Function IsExistSheet(sheetName) As Boolean Dim sheet As Worksheet For Each sheet In Worksheets If sheet.Name = sheetName Then IsExistSheet = True Exit Function End If Next sheet IsExistSheet = False End Function Function CheckVerified(sheetName) As Boolean If IsExistSheet(sheetName) Then If (MsgBox("そのシート (" & sheetName & ") は既に存在します。上書きしますか?", vbOKCancel, "上書き確認") = vbOK) Then Application.DisplayAlerts = False Worksheets(sheetName).Delete Application.DisplayAlerts = True Else CheckVerified = False Exit Function End If End If CheckVerified = True End Function Sub CreateBill(Vendor As Vendor, Color) Set WS1 = Worksheets("sheet1") Set WS3 = Worksheets("sheet3") Dim sheetName As String sheetName = Vendor.Name & "請求書" If Not CheckVerified(sheetName) Then Exit Sub WS3.Copy after:=WS3 With ActiveSheet .Name = sheetName .Range("B6") = Vendor.Name & " " & Vendor.PersonName .Range("C9") = WS1.Range("A1") .Range("E9") = Name .Range("F4") = Date .Range("B2") = "請求者番号: " & Vendor.Code .Tab.ColorIndex = Color End With End Sub Function CreateVendor(RowNumber) As Vendor Set WS1 = Worksheets("sheet1") Dim newVendor As Vendor With newVendor .Name = WS1.Range("B" & RowNumber) .Code = WS1.Range("A" & RowNumber) .PersonName = WS1.Range("C" & RowNumber) End With CreateVendor = newVendor End Function Sub 請求書作成() Set WS1 = Worksheets("sheet1") Dim FukayamaSyokuhin As Vendor Dim LuckyMarket As Vendor Dim YukimiTei As Vendor FukayamaSyokuhin = CreateVendor(4) CreateBill FukayamaSyokuhin, 6 LuckyMarket = CreateVendor(5) CreateBill LuckyMarket, 8 YukimiTei = CreateVendor(6) CreateBill YukimiTei, 4 End Sub ' vim:set ft=vb ff=dos: