対象者時給計算表テンプレートシートを作成するVBA

生成した個人別時給計算表エクセルに、対象者時給計算表テンプレートシートを作成します。
作表だけでなく、同名シートチェック、他ブックの流用、入力済データの処理なども必要になります。

こんにちは、じゅんぱ店長（@junpa33）です。

エクセルVBAで作る時給計算表の作成記事の3回目です。

今回は、個人別の時給計算表エクセルブックに対象者時給計算表テンプレートを作成するVBAコードを組み立てます。

時給計算表作成の記事編成

時給計算表作成エクセルソフトの使い方とダウンロード
- 時給計算表エクセルソフト無料ダウンロードと取り扱い説明

時給計算表作成エクセルソフトの作成手順

コンテンツ

対象者時給計算表テンプレートシートの使い方

先回に作成した個人別時給計算表の「Sheet1」シートをリネームで「対象者時給計算表」として、そこに計算表テンプレートを作成します。

対象者時給計算表テンプレートの作成完了イメージ

「Sheet1」をリネームした名前は「（対象者）時給計算表」となります。

時間データの入力は、「〇〇：〇〇の24時表示を行います。

対象者時給計算表テンプレートの操作方法

自動作成した個人名の時給計算表.xlsmで、「テンプレート作成」ボタンをクリックすることで、テンプレートが生成されます。

シート名は「対象者時給計算表」として作成されます。（この場合では「あき時給計算表」）

エクセルでエラーが発生するケースとして、

既にシートが存在する場合
「Sheet1」シートが無い場合（リネームするシートが無い）
「初期設定項目」シートしかない場合

の場合がありますので、VBAコード上で事前にエラー対処しておきます。

作成したテンプレートにデータを入力していきますが、「時給」と「時間外時給」を表示させるには「初期設定項目」シートの項目欄に事前にデータを入力しておく必要があります。

後で、「時給」と「時間外時給」のデータを入力（修正）して、「テンプレート作成」ボタンを再度クリックすることで、「対象者時給計算表」の表示を変更することは可能です。

ただし、既に入力されているそれまでの実労時間分まで修正後の時給の計算対象となります。

会計期間途中で時給金額を変更する場合は、一旦それまでの時給計算を完了し、それまで入力したデータを「計算シート保存」ボタンで別名シートとして書き出し保存しておく必要があります。

ほかには、

会計期間は、「対象者時給計算表」シートを保存する前に入力されていればOKです。

「マルメ」項目は、給与計算前に入力してあればOKです。

対象者時給計算表テンプレートの作成時の不適切操作

対象者時給計算表テンプレートシートを作成するには、「時給計算表.xlsm」や「個人別時給計算表.xlsm」を操作する必要があります。その中で不適な操作を行ってしまう場合があります。

対象者の「個人別時給計算表.xlsm」が既に存在している場合
別人の「個人別時給計算表.xlsm」で「対象者」名を変更しようとした場合

のイレギュラーな操作に対しての対策コードをプログラムに設置しています。

同名の個人別時給計算表.xlsmがすでに存在する

１．同じ名前で作ろうとした場合

メッセージが表示されます。どのようにするかを選択します。

◎「はい」ボタンで、作業を終了します。（何も起こしません。）

◎「いいえ」ボタンを押すと、ファイル名に＋日付（年月日）付きで保存します。

データを緊急避難させたい場合に対処しています。

◎「キャンセル」ボタンを押すと、メッセージボックスで「終了します。」、「OK」ボタンで終了です。（何も起こしません。）

対象者を変更して時給計算表テンプレート作成を試みる

対象者「あき」で対象者時給計算表テンプレートを作成しました。

対象者時給計算表テンプレートを作成後、対象者を「はる」に変更しようとしました。

作業を進めるために、「テンプレート作成」ボタンをクリックしました。

するとメッセージボックスで「対象者1人に対して1ブックです。」とメッセージが現れます。

ファイル名は「時給計算表-あき,xlsm」です。（対象者名を「はる」に変更しても、対象者時給計算表テンプレートを転用することはできません。<不正操作禁止>）

メッセージボックスの「OK」ボタンを押すと、対象者が「あき」に修正回復されました。

目次へ戻る

対象者時給計算表テンプレートシート作成のVBA

ここからは、VBE（ビジュアルベーシックエディタ）で「Module2」に記述していきます。

パブリック変数の再確認

先ず最初に先回の記事でModule1の宣言セクションで宣言した変数と、

変数に代入する値を規定するプロシージャーを確認しておきます。

2021年1月6日エクセル時給計算表の作成手順と初期設定項目入力シート

VBA

Option Explicit

    Public EmpName As String, 年月日 As String
    Public OriBName As String
    Public TCos, TwCos, TMal, KMal
    Public SD, ED As Variant
    Public KShH As Boolean
    Dim SaName As String, SaNamea As String

VBA

Sub 設定値代入()
    Dim MB As Long
        Worksheets("初期設定項目").Select
'会計期間をセット
        Range("D5", "F5").NumberFormatLocal = "dd"
STEP0:
        If Range("D5") = "" Then
            MsgBox "会計期間が未入力です。" & vbCrLf & "入力してください。" _
                        , vbExclamation, "時給計算表作成"
STOP1:
            On Error Resume Next
            SD = Application.InputBox("開始日を入力してください。", _
                        Title:="時給計算表作成", Type:=2)
            On Error GoTo 0
            If SD = False Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            ElseIf SD = "" Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            ElseIf SD < 1 Or SD > 31 Then
                MsgBox "異常値ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP1
            Else
                With Worksheets("初期設定項目")
                    .Range("D5").Value = SD
                End With
            End If
        ElseIf Range("D5") < 1 Or Range("D5") > 31 Then
            MsgBox "異常値ではテンプレート作成出来ません。", _
                        vbExclamation, "時給計算表作成"
            Range("D5") = ""
            GoTo STEP0:
        Else
            With Worksheets("初期設定項目")
                .Range("D5").Value = SD
            End With
        End If
STEP2:
        If Range("F5") = "" Then
            MsgBox "会計期間が未入力です。" & vbCrLf & "入力してください。" _
                        , vbExclamation, "時給計算表作成"
STOP3:
            On Error Resume Next
            ED = Application.InputBox("開始日を入力してください。", _
                        Title:="時給計算表作成", Type:=2)
            On Error GoTo 0
            If ED = False Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            ElseIf ED = "" Then
                MsgBox "日付未入力ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            ElseIf ED < 1 Or ED > 31 Then
                MsgBox "異常値ではテンプレート作成出来ません。", _
                            vbExclamation, "時給計算表作成"
                GoTo STOP3
            Else
                With Worksheets("初期設定項目")
                    .Range("F5").Value = ED
                End With
            End If
        ElseIf Range("F5") < 1 Or Range("F5") > 31 Then
            MsgBox "異常値ではテンプレート作成出来ません。", _
                        vbExclamation, "時給計算表作成"
            Range("F5") = ""
            GoTo STEP2:
        Else
            With Worksheets("初期設定項目")
                .Range("F5").Value = ED
            End With
        End If
        With Worksheets("初期設定項目")
            SD = .Range("D5").Value
            ED = .Range("F5").Value
        End With
'対象者名を変数に代入します
        EmpName = Worksheets("初期設定項目").Range("C6").Value
'基本時給をセット
        TCos = Worksheets("初期設定項目").Range("C7").Value
'時間外割増率をセット
        TwCos = Worksheets("初期設定項目").Range("F7").Value / 100
'時間マルメをセット
        TMal = Worksheets("初期設定項目").Range("C8").Value
'金額マルメをセット
        KMal = Worksheets("初期設定項目").Range("C9").Value
'計算シートの保存法を取得
        KShH = Worksheets("初期設定項目").Range("E10").Value
End Sub

これはすでにModule1で記述しているコードです。

再度Module2に記述する必要はありません。

テンプレート作成のVBAコード

VBA

Option Explicit

Dim BRow As Long

Sub テンプレート()
    Dim Sh As Worksheet
    Dim res, flg As Boolean
    Dim OldEmpName As String
    Dim MGB As Long
    Dim TC, TCW As Variant
        OldEmpName = Worksheets("初期設定項目").Range("H5")
        Call Module1.設定値代入
        If EmpName <> OldEmpName Then
            MsgBox "対象者1人に対して１ブックです。" & vbCrLf & _
                "Bookを閉じて設定をやり直してください。" _
                & vbCrLf & "まだの場合は対象者計算Bookを" & _
                "作成してください。", vbExclamation, "時給計算表作成"
            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
'Sheet1があるかをチェックします
            If Sh.Name = "Sheet1" Then flg = True
        Next
'Sheet1が無い場合は追加して設置します
            If flg = False And res = False Then Worksheets _
                .Add(after:=Worksheets("初期設定項目")).Name = "Sheet1"
'計算シート名が無い場合はSheet1の名前を変更します
            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 "消去は行いません。", vbInformation, _
                        "時給計算表作成"
                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("初期設定項目")
            .Select
            TC = .Range("C7")
            TCW = .Range("F7")
'時給と時間外割増が設定されていない時の入力処理
BACK:
            If TC = "" Then
                TC = Application.InputBox("時給を入力してください。", _
                    Title:="時給計算表作成", Type:=1)
                If TC = 0 Then
                    MsgBox "時給0円ではテンプレート作成出来ません。", _
                        vbExclamation, "時給計算表作成"
                    GoTo BACK
                End If
            End If
            If TCW = "" Then
                TCW = Application.InputBox("時間外割増を入力してください。" _
                    , Title:="時給計算表作成", Type:=1)
                If TCW = 0 Then
                    MsgBox "時間外割増無しとします。", vbExclamation, _
                        "時給計算表作成"
                End If
            End If
            .Range("C7") = TC
            .Range("F7") = TCW
        End With
'時給と時間外割増を表示する
        With Worksheets(EmpName & "時給計算表")
            .Select
            With .Range("E1:F1")
                .Merge
                .Value = "時給＝" & Val(TC) & "円"
                .Font.Size = 14
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
            End With
            With .Range("G1:H1")
                .Merge
                .Value = "時間外時給＝" & TCW & "　%"
                .Font.Size = 14
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
            End With
'行列のセルサイズを設定します
            .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