個人の時給計算表に金額計算テンプレートを作成。時給の計算その3

Option Explicit
Dim BRow As Long

Sub テンプレート()

Dim Sh As Worksheet
Dim res As Boolean
Dim OldEmpName As String
Dim MGB As Long

'Module1で作成したマーカーを変数に代入します
OldEmpName = Worksheets("初期設定項目").Range("H5")

Call Module1.設定値代入

'今現在の対象者がマーカーと一致するかどうかで条件分岐します
If EmpName <> OldEmpName Then
    MsgBox "対象者1人に対して１ブックです。" & vbCrLf & "Bookを閉じて設定をやり直してください。" _
　　& vbCrLf & "まだの場合は対象者計算Bookを作成してください。"
    Worksheets("初期設定項目").Range("C6") = OldEmpName
    Exit Sub
End If

'シート名を付けます
res = False

For Each Sh In Worksheets

'既にシート名が存在している場合
    If Sh.Name = EmpName & "時給計算表" Then
        res = True
        Exit For
    End If
Next

'シート名が存在しない場合
    If res = False Then
        Worksheets("Sheet1").Name = EmpName & "時給計算表"
    End If  

Worksheets(EmpName & "時給計算表").Select

'すでにデータが記述されている場合
If Range("B3") <> "" Then

'メッセージボックスを表示します
    MGB = MsgBox("計算表にデータが存在します。" & vbCrLf & "クリアしますか？", _
            vbYesNo + vbExclamation, "消去確認")

'「はい」ボタンを選択
        If MGB = vbYes Then
            Range("A1:K34").ClearContents

'「いいえ」ボタンを選択
        ElseIf MGB = vbNo Then
            MsgBox "消去は行いません。"
        End If
End If

'表のタイトルを記入します。
Worksheets(EmpName & "時給計算表").Select
    With Range("A1")
        .Value = EmpName & "時給計算表"
        .Font.Size = 18
        .HorizontalAlignment = xlCenter
    End With
    Range("A1:D1").Merge

With Worksheets(EmpName & "時給計算表")

'行列のセルサイズを設定します
    .Rows("1:2").RowHeight = 27
    .Rows("3:34").RowHeight = 16.7
    .Rows("33").RowHeight = 27
    .Columns("A").ColumnWidth = 5
    .Columns("B:K").ColumnWidth = 13
    
'それぞれの罫線を設定します
    With Range("B2:K32")
        .Borders.LineStyle = xlDot
        .Borders.Weight = xlHairline
        .BorderAround LineStyle:=xlContinuous
    End With
    
    .Range("B2:K2").Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range("B2:K2").Borders(xlEdgeBottom).Weight = xlThin
    .Range("B32:K32").Borders(xlEdgeTop).LineStyle = xlContinuous
    .Range("B32:K32").Borders(xlEdgeTop).Weight = xlThin
    .Range("B2:B32").Borders(xlEdgeRight).LineStyle = xlContinuous
    .Range("B2:B32").Borders(xlEdgeRight).Weight = xlThin
    .Range("I2:I32").BorderAround LineStyle:=xlContinuous
    .Range("F33:I34").BorderAround LineStyle:=xlContinuous
    .Range("F34:I34").Borders(xlEdgeTop).LineStyle = xlContinuous
    .Range("F34:I34").Borders(xlEdgeTop).Weight = xlHairline
    .Range("F33:H34").Borders(xlInsideVertical).LineStyle = xlContinuous
    .Range("F33:H34").Borders(xlInsideVertical).Weight = xlHairline
    .Range("H33:H34").Borders(xlEdgeRight).LineStyle = xlContinuous
    .Range("H33:H34").Borders(xlEdgeRight).Weight = xlThin

'見出し項目を記入します
    .Range("B2").Value = "日時"
    .Range("C2").Value = "基準時間"
    .Range("D2").Value = "出社時間"
    .Range("E2").Value = "退社時間"
    .Range("F2").Value = "休憩時間"
    .Range("G2").Value = "実労時間"
    .Range("H2").Value = "(内)時間外時間"
    .Range("I2").Value = "支給金額"
    .Range("J2").Value = "(内)規定時間金額"
    .Range("K2").Value = "(内)時間外金額"
    .Range("B32").Value = "合計"
    .Range("F33").Value = "金額マルメ"
    .Range("G33").Value = "実労時間マルメ"
    .Range("H33").Value = "時間外時間マルメ"
    .Range("I33").Value = "マルメ支給額"

    .Range("B2:K2").ShrinkToFit = True
    .Range("B33:K33").ShrinkToFit = True
    
    .Range("B3:B31").NumberFormatLocal = "yy/mm/dd"
    .Range("C3:H32").NumberFormatLocal = "[h]:mm;@"
    .Range("G34:H34").NumberFormatLocal = "[h]:mm;@"
    .Range("I3:K32").NumberFormatLocal = "\#,##0;[赤]\-#,##0"
    .Range("I34").NumberFormatLocal = "\#,##0;[赤]\-#,##0"
    .Range("B32:K32").Font.Bold = True
    With Range("F33:I34")
        .Font.Bold = True
        .Font.ColorIndex = 5
    End With

End With

End Sub