個人別時給計算表を自動で作成するVBA。時給の計算その2

Sub 対象者用時間計算作成()

Dim ThisName As String, NewDir As String
Dim MojiCoA As Integer
Dim Wb As Workbook
Dim res As Boolean
Dim MBsa As Long, MBtn As Long

Call 設定値代入

'拡張子なしのファイル名を取得します
    MojiCoA = InStrRev(ThisWorkbook.Name, ".")
    ThisName = Left(ThisWorkbook.Name, MojiCoA - 1)
    
    ThisWorkbook.Save

'保存場所と保存ファイル名を変数へ代入します
    NewDir = ThisWorkbook.Path & "\計算メンバー"
    SaName = ThisName & "-" & EmpName & ".xlsm"
    SaNamea = ThisName & "-" & EmpName & Format(Date, "yymmdd") & ".xlsm"

'保存フォルダが既にあるかどうかを調べますーーーー①
If Dir(NewDir, vbDirectory) = "" Then
    MkDir NewDir
End If

'ディレクトリを変更しますーーーー②
ChDir NewDir

'保存したいファイルが既に存在するかを調べますーーーー③
If Dir(SaName, vbNormal) = "" Then

'------存在しない場合この名前でファイルを保存します
    ThisWorkbook.SaveAs (SaName)
    MsgBox "ファイルを保存しました。"

Else

'------存在する場合メッセージボックスで判断分岐をします。ファイル保存の場合は別名とします    
    MBtn = MsgBox("ファイルは既に存在します。" & vbCrLf & "終了しますか？", _
           vbYesNoCancel + vbExclamation, "保存問合せ")
    
        If MBtn = vbYes Then
            Exit Sub
        
        ElseIf MBtn = vbNo Then
            MsgBox "日付付きで保存します。"
            ThisWorkbook.SaveAs (SaNamea)
            
        ElseIf MBtn = vbCancel Then
            MsgBox "終了します。"
            Exit Sub
            
        End If
    
End If

'対象者名をファイル名と一致させるためのマーカーを作りますーーーー④
With Worksheets("初期設定項目").Range("H5")
    .Value = Worksheets("初期設定項目").Range("C6")
'-------文字色を白にして目立たないようにする
    .Font.ColorIndex = 2
End With

 Call 計算Bookコマンド削除
    
End Sub

Sub 計算Bookコマンド削除()

Dim CommButton As Object

OriBName = "時給計算表.xlsm"

'テンプレートファイルであれば終了します
If ThisWorkbook.Name = OriBName Then

    Exit Sub
    
Else

    For Each CommButton In Worksheets("初期設定項目").Shapes

'「対象者計算Book作成」ボタンだけを削除します
        If CommButton.Name = "対象者計算Book作成" Then
            Worksheets("初期設定項目").Shapes(CommButton.Name).Delete
            Exit Sub
        End If

    Next

End If

End Sub

Sub ブックを保存()

Dim OpBook As Workbook

For Each OpBook In Workbooks
    
    OpBook.Save
                
Next

'エクセルを終了します
 Application.Quit
 
End Sub