VBAのコードを綺麗にする等していた

人が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: