出勤簿を作る (5)

ラボ

はじめに

 今回の出勤簿シートでは、実働時間や日付、曜日、合計などで数式マクロを使用しています。
 ご存知の通り、数式マクロの入ったセルに直接数値や文字を上書きしてしまうと数式マクロは消えてしまいます。

 筆者が運用していた出勤簿の事例ですが、合計値を勝手に入力されてしまい、エラーになかなか気付けなかったという事がありました。
 これを改善するために、何らかのタイミングで出勤簿シートの数式マクロを全て書き直すという手段を取りました。
 書き変えのタイミングは、「チェック」というボタンを設けていましたが、シートが切り替わるイベントで実行しても良いでしょう。

セルの数式マクロを書き直すプログラム

 以前、「セルの数式マクロを復活させる」という記事を書いたのですが、今回はこれを利用することにします。
 
  ・セルの数式マクロを復活させる

 ここで紹介したプログラムを使えば、いちいち数式マクロの位置や内容を書き出さなくてもプログラムを実行すれば勝手にイミディエイトウィンドウに出力してくれます。もし、原本の内容を変更した時でも簡単に対応できますのでお勧めです。
 内容の詳細を知りたい方は上記の記事を参照してください。

 プログラムは以下の通りです。

'エスケープシーケンスを考慮した文字列を得る
Function getEscString(ByVal s As String)
    Dim escStr As String
    escStr = Replace(s, """", """""") 
    escStr = """" & escStr & """"
    getEscString = escStr
End Function

'アクティブシートの数式マクロを復活するコードを生成するプログラム
Sub buildMyCode()
    
    Dim r As Range
    Dim myRange As Range
        
    Set myRange = Range("A1:Z100")      '適当に大きめの範囲を指定
        
    Debug.Print "Sub writeMyFormula()"
    
    For Each r In myRange
        If r.HasFormula Then
            Debug.Print "    Cells(" & r.Row & "," & r.Column & ")=" & getEscString(r.Formula)
        End If
    Next r
     
    Debug.Print "End Sub"
End Sub

 このプログラムは、アクティブシートの数式マクロを復活させるコードをイミディエイトウィンドウに書き出します。
 必要に応じてmyRangeで設定するセル範囲を変更してください。
 
 今回は、原本シートをアクティブにして実行すれば良いでしょう。myRangeの設定変更も不要です。

実行すると以下のようなコードがイミディエイトウィンドウに書き出されますので、コピーして標準モジュールに貼り付けます。

Sub writeMyFormula()
    Cells(2,13)="=H36"
    Cells(5,2)="=DATE(YEAR(B1),MONTH(B1)-1,21)"
    Cells(5,3)="=B5"
    Cells(5,8)="=(F5-E5)*24-G5-I5"
    Cells(6,2)="=B5+1"
    Cells(6,3)="=B6"
    Cells(6,8)="=(F6-E6)*24-G6-I6"
    Cells(7,2)="=B6+1"
    Cells(7,3)="=B7"
    Cells(7,8)="=(F7-E7)*24-G7-I7"
    Cells(8,2)="=B7+1"
    Cells(8,3)="=B8"
    Cells(8,8)="=(F8-E8)*24-G8-I8"
    Cells(9,2)="=B8+1"
    Cells(9,3)="=B9"
    Cells(9,8)="=(F9-E9)*24-G9-I9"
    Cells(10,2)="=B9+1"
    Cells(10,3)="=B10"
    Cells(10,8)="=(F10-E10)*24-G10-I10"
    Cells(11,2)="=B10+1"
    Cells(11,3)="=B11"
    Cells(11,8)="=(F11-E11)*24-G11-I11"
    Cells(12,2)="=B11+1"
    Cells(12,3)="=B12"
    Cells(12,8)="=(F12-E12)*24-G12-I12"
    Cells(13,2)="=B12+1"
    Cells(13,3)="=B13"
    Cells(13,8)="=(F13-E13)*24-G13-I13"
    Cells(14,2)="=B13+1"
    Cells(14,3)="=B14"
    Cells(14,8)="=(F14-E14)*24-G14-I14"
    Cells(15,2)="=B14+1"
    Cells(15,3)="=B15"
    Cells(15,8)="=(F15-E15)*24-G15-I15"
    Cells(16,2)="=B15+1"
    Cells(16,3)="=B16"
    Cells(16,8)="=(F16-E16)*24-G16-I16"
    Cells(17,2)="=B16+1"
    Cells(17,3)="=B17"
    Cells(17,8)="=(F17-E17)*24-G17-I17"
    Cells(18,2)="=B17+1"
    Cells(18,3)="=B18"
    Cells(18,8)="=(F18-E18)*24-G18-I18"
    Cells(19,2)="=B18+1"
    Cells(19,3)="=B19"
    Cells(19,8)="=(F19-E19)*24-G19-I19"
    Cells(20,2)="=B19+1"
    Cells(20,3)="=B20"
    Cells(20,8)="=(F20-E20)*24-G20-I20"
    Cells(21,2)="=B20+1"
    Cells(21,3)="=B21"
    Cells(21,8)="=(F21-E21)*24-G21-I21"
    Cells(22,2)="=B21+1"
    Cells(22,3)="=B22"
    Cells(22,8)="=(F22-E22)*24-G22-I22"
    Cells(23,2)="=B22+1"
    Cells(23,3)="=B23"
    Cells(23,8)="=(F23-E23)*24-G23-I23"
    Cells(24,2)="=B23+1"
    Cells(24,3)="=B24"
    Cells(24,8)="=(F24-E24)*24-G24-I24"
    Cells(25,2)="=B24+1"
    Cells(25,3)="=B25"
    Cells(25,8)="=(F25-E25)*24-G25-I25"
    Cells(26,2)="=B25+1"
    Cells(26,3)="=B26"
    Cells(26,8)="=(F26-E26)*24-G26-I26"
    Cells(27,2)="=B26+1"
    Cells(27,3)="=B27"
    Cells(27,8)="=(F27-E27)*24-G27-I27"
    Cells(28,2)="=B27+1"
    Cells(28,3)="=B28"
    Cells(28,8)="=(F28-E28)*24-G28-I28"
    Cells(29,2)="=B28+1"
    Cells(29,3)="=B29"
    Cells(29,8)="=(F29-E29)*24-G29-I29"
    Cells(30,2)="=B29+1"
    Cells(30,3)="=B30"
    Cells(30,8)="=(F30-E30)*24-G30-I30"
    Cells(31,2)="=B30+1"
    Cells(31,3)="=B31"
    Cells(31,8)="=(F31-E31)*24-G31-I31"
    Cells(32,2)="=IF(DAY($B$31+1)>20,"""",$B$31+1)"
    Cells(32,3)="=B32"
    Cells(32,8)="=(F32-E32)*24-G32-I32"
    Cells(33,2)="=IF(DAY($B$31+2)>20,"""",$B$31+2)"
    Cells(33,3)="=B33"
    Cells(33,8)="=(F33-E33)*24-G33-I33"
    Cells(34,2)="=IF(DAY($B$31+3)>20,"""",$B$31+3)"
    Cells(34,3)="=B34"
    Cells(34,8)="=(F34-E34)*24-G34-I34"
    Cells(35,2)="=IF(DAY($B$31+4)>20,"""",$B$31+4)"
    Cells(35,3)="=B35"
    Cells(35,8)="=(F35-E35)*24-G35-I35"
    Cells(36,8)="=SUM(H5:H35)"
    Cells(36,9)="=SUM(I5:I35)"
    Cells(36,10)="=SUM(J5:J35)"
    Cells(36,11)="=SUM(K5:K35)"
    Cells(36,12)="=SUM(L5:L35)"
End Sub

 とても冗長なプログラムで手作業だと間違えそうですが、プログラムを使えば簡単に出力できます。
 これをマクロを復活させたいタイミングで実行すればOKです。

数式マクロの書き直しをテスト

 今回は、自動で数式マクロの書き換えをイベントプロシージャで実行するようにしてみます。
 イベントは、ThisWorkbookモジュールのSheetActivate(シートがアクティブになった時)で実行するようにします。

 ブログラムは以下の通りです。原本シートから作られたシート以外はパスするようにします。
尚、書き直されたか分かりづらいのでDebug.Printで書き直しを行ったシート名を表示させています。

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "メニュー" And _
       Sh.Name <> "勤務パターン" And _
       Sh.Name <> "社員リスト" And _
       Sh.Name <> "集計" Then
        
        Call writeMyFormula
        Debug.Print Sh.Name & " 数式マクロ書換え"
    End If
End Sub

 社員の出勤簿シートのマクロ部分を数値などで上書きして、別のシートに変更し、戻ってみると数式マクロが元に戻っているのが確認できると思います。
 この方法ですとシート変更のたびに数式マクロの書き換えを行いますので数式マクロが多いと処理が重くなってしまうかもしれません。ただ、今回の量であればそれほど気にならないと思います。

 頻繁に書き換えたくない場合は、ボタンを設けてwriteMyFormula()を実行しても良いでしょう。

 もし、出勤簿の設計を変更する際は、buildMyCode() を実行して、 writeMyFormula()を作り直す必要性が出てきますので注意してください。

最後に

 今回は数式マクロの書き換えを防止するアイデアを紹介しました。プログラムコードをイミディエイトウインドウに書き出すというのは中々斬新で面白いと思いませんか?
 出勤簿プログラム以外にも利用できると思いますので活用してみてください。

 
 次回は、計算エラーを探知するプログラムを書いてみます。
 例えば、実働時間が 8h なのに、有給を 9h 取得していたら間違いですね。このように起こりそうなエラーを想定して、欄外にマークを付けて注意喚起するプログラムになります。

タイトルとURLをコピーしました