VBA自分ルール

・シートモジュールのマクロはシートに閉じたPrivateクラスとして構成
・ThisWorkbookモジュールのマクロは各シート間に渡る処理
・標準モジュールのマクロは共通処理
・クラスモジュールのマクロは共通処理でクラス化が妥当のもの

・変数や関数名は可能な限り2バイト日本語
・Function名はF_関数名
・Sub名はS_関数名
・関数内変数はv_変数名
・関数の引数はp_変数名
・グローバル変数はg_変数名
・Const変数？はc_変数名
・配列変数はa_変数名
・大量のセルを扱う場合は配列変数で
・書式なしコピーは Range("A1:A100").Value = Range("B1:B100").Value

命名規則の標準化で、変数一覧、未使用変数チェック、メソッド一覧、メソッド関連図を自動生成
変数や関数に日本語を使用して、説明コメントを削減
納品時にErl用行番号、On Error Gotoの自動付与とデバッグ時の自動付与行番号の削除を自動化

以下自分ルールは適用していません・・汗

Erlを使うための行番号挿入と削除

Const vbext_ct_StdModule As Variant = 1
Const vbext_ct_MSForm As Variant = 2
Const vbext_ct_ClassModule As Variant = 3
Const vbext_ct_ActiveXDesigner = 11
Const vbext_ct_Document = 100

Dim lno As Integer
Dim cmdStr As String
Dim cmCnt As Integer

Sub smdStrAdd(txt)
    cmCnt = cmCnt + 1
    cmdStr = cmdStr & txt & vbNewLine
End Sub


Public Sub トラップコード削除()
    If MsgBox(ActiveWorkbook.Name & vbNewLine & _
        "のトラップコード削除", vbExclamation + vbOKCancel) = vbCancel Then
        Exit Sub
    End If
    
    With ActiveWorkbook.VBProject
        For Each c In .VBComponents
            Select Case c.Type
            Case vbext_ct_StdModule
            Case vbext_ct_MSForm
            Case vbext_ct_ClassModule, vbext_ct_Document
            Case Else
                GoTo skip
            End Select
            
            If c.CodeModule.CountOfLines > 0 Then
                lcnt = c.CodeModule.CountOfLines
                cmCnt = 1
                cmdStr = ""
                
                If コード削除(c) Then
                    c.CodeModule.InsertLines 1, cmdStr
                    c.CodeModule.DeleteLines cmCnt, lcnt + 1
                End If
            End If
skip:
        Next
    End With

    MsgBox "トラップコード削除しました。"
End Sub

Private Function コード削除(ByRef cm)
    cd = cm.CodeModule.Lines(1, cm.CodeModule.CountOfLines)
    cdList = Split(cd, vbNewLine)
    
    '-- 挿入済み
    If Not cdList(0) = "'--Trap 挿入済み" Then
        コード削除 = False
        Exit Function
    End If
    
    For i = LBound(cdList) + 1 To UBound(cdList)
        If Not cdList(i) Like "*'--Trap" Then
            smdStrAdd cdList(i)
        End If
    Next
    
    コード削除 = True
End Function

Public Sub トラップコード挿入()
    Dim ext As String
    Dim c As Object
    
    If MsgBox(ActiveWorkbook.Name & vbNewLine & _
        "のトラップコード挿入", vbExclamation + vbOKCancel) = vbCancel Then
        Exit Sub
    End If
    
    Application.EnableEvents = False
    
    lno = 1
    
    With ActiveWorkbook.VBProject
        For Each c In .VBComponents
            Select Case c.Type
            Case vbext_ct_StdModule
            Case vbext_ct_MSForm
            Case vbext_ct_ClassModule, vbext_ct_Document
            Case Else
                GoTo skip
            End Select
            
            
            If c.CodeModule.CountOfLines > 0 Then
                lcnt = c.CodeModule.CountOfLines
                cmCnt = 1
                cmdStr = ""
                
                If コード挿入(c) Then
                    c.CodeModule.InsertLines 1, cmdStr
                    c.CodeModule.DeleteLines cmCnt, lcnt + 1
                End If
            End If
skip:
        Next
    End With
    
    MsgBox "トラップコード挿入しました。"
    
    Application.EnableEvents = True
End Sub

Private Function コード挿入(ByRef cm)
    cd = cm.CodeModule.Lines(1, cm.CodeModule.CountOfLines)
    cdList = Split(cd, vbNewLine)
    
    '-- 挿入済み
    If cdList(0) = "'--Trap 挿入済み" Or cdList(0) = "'--#Trap" Then
        コード挿入 = False
        Exit Function
    End If
    
    smdStrAdd "'--Trap 挿入済み"
    
    stFlag = False
    cFlag = False
    first = False

    
    For i = LBound(cdList) To UBound(cdList)
        Select Case True
        Case cdList(i) = "End Sub"
            smdStrAdd "    exit sub '--Trap"
            
            smdStrAdd "trap: '--Trap"
            smdStrAdd "    ErrTrap '--Trap"
            
            stFlag = False
            first = False
        
        Case cdList(i) = "End Function"
            smdStrAdd "    exit function '--Trap"
            
            smdStrAdd "trap: '--Trap"
            smdStrAdd "    ErrTrap '--Trap"
            
            stFlag = False
            first = False
        End Select
        
        cmd = Trim(cdList(i))
        
        Select Case True
        Case cmd Like "Select Case *"
        Case cmd Like "Case *"
        Case cmd Like "End Select"
        Case stFlag
            If cmd <> "" Then
                If Not cFlag Then
                    If Left(cmd, 1) <> "'" Then
                        smdStrAdd lno & " '--Trap"
                        lno = lno + 1
                    End If
                End If
            End If
        End Select
        
        smdStrAdd cdList(i)
        
        If Right(cmd, 1) = "_" Then
            cFlag = True
        Else
            cFlag = False
        End If
        
        Select Case True
        Case Left(cmd, 1) = "'"
        Case cmd Like "*Function * Lib *"
        
        Case cmd Like "*Sub *"
            stFlag = True
            first = True
        
        Case cmd Like "*Function *"
            If i > 1 Then
                If Not cdList(i - 1) = "'--#Trap" Then
                    stFlag = True
                    first = True
                End If
            End If
        End Select
        
        If first And stFlag And Not cFlag Then
            smdStrAdd "    on error goto trap '--Trap"
            first = False
        End If
skip:
    Next
    
    コード挿入 = True
End Function

モジュールを一括エクスポートする

出力先エクスポートファイルと比較して差分があるものだけ出力するので、Git管理に便利！
(https://gist.github.com/toagit/4561c2813bccf39aef0e2256822f3905 より引用)

'全モジュールエクスポート
'
'Excelの設定を以下の通りに変更すること
'１）オプション -> セキュリティーセンター -> [セキュリティーセンターの設定]ボタン押下
'２）マクロ設定（左ペイン） -> [VBAプロジェクトオブジェクトモデルへのアクセスを信頼する]　チェックON

# If VBA7 And Win64 Then
    Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" ( _
                                                                  ByVal hwnd As Long, _
                                                                  ByVal pszPath As String, _
                                                                  ByVal psa As Long) As Long
# Else
    Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" ( _
                                                                  ByVal hwnd As Long, _
                                                                  ByVal pszPath As String, _
                                                                  ByVal psa As Long) As Long
# End If

Public Sub ExportAllModule()
    Dim destDir As String
    Dim rc As Long
    
    If MsgBox(ActiveWorkbook.Name & vbNewLine & "マクロを一括エクスポートします!", vbQuestion + vbYesNo) = vbNo Then
        Exit Sub
    End If
    
    destDir = ActiveWorkbook.Path & "\modules\" & ActiveWorkbook.Name
    
    rc = SHCreateDirectoryEx(0&, destDir, 0&)
    
    cnt = 0
    
    With ActiveWorkbook.VBProject
        Const vbext_ct_StdModule As Variant = 1
        Const vbext_ct_MSForm As Variant = 2
        Const vbext_ct_ClassModule As Variant = 3
        
        Dim ext As String
        Dim c As Object
        For Each c In .VBComponents
            Select Case c.Type
            Case vbext_ct_StdModule
                ext = ".bas"
            Case vbext_ct_MSForm
                ext = ".frm"
            Case vbext_ct_ClassModule, 100
                ext = ".cls"
            Case Else
                ext = Empty
            End Select
            
            If ext <> Empty Then
                cd = c.CodeModule.Lines(1, c.CodeModule.CountOfLines)
                fpath = destDir & "\" & c.Name & ext
                If 比較(cd, fpath) Then
                    Call c.Export(destDir & "\" & c.Name & ext)
                    cnt = cnt + 1
                End If
            End If
            
        Next
    
    End With
    
    MsgBox "モジュールのエクスポートを " & cnt & "件 完了しました。" & vbNewLine & destDir
End Sub

Function 比較(ByRef cd, fpath)
    比較 = True
    
    If Dir(fpath) = "" Then
        Exit Function
    End If
    
    Open fpath For Input As #1
    
    cdList = Split(cd, vbNewLine)
    
    i = 0
    begin = False
    
    Do Until EOF(1)
        Line Input #1, buf
        Select Case True
        Case Left(buf, 9) = "Attribute"
        Case Left(buf, 7) = "VERSION"
        Case UCase(Left(buf, 5)) = "BEGIN"
            begin = True
        Case buf = "END" And begin
            If begin Then
                begin = False
            End If
        Case begin
        Case Else
            If UBound(cdList) < i Then
                    GoTo stp
            End If
            If cdList(i) <> buf Then
                    GoTo stp
            End If
            i = i + 1
        End Select
    Loop
    
    比較 = False

stp:
    Close #1
End Function