「エクセル日記」の作り方～その４～
最終回である。日記シートの写真日記ボタンのClick()イベント。以下のプロシージャでは日記シートと写真シートの日付を同期させている。
Private Sub CommandButton7_Click() ‘写真日記
Dim 選択行 As Long
Dim 選択範囲行 As Long
Dim 参照日付 As Date
Dim 日付 As Date
選択行 = Selection.Row
参照日付 = Cells(選択行, 3).Value
With Sheets(“写真”)
.Visible = True
.Select
.ScrollArea = “C5:S65536”
End With
For 選択範囲行 = 5 To 65536
日付 = Cells(選択範囲行, 3).Value
If 日付 = 参照日付 Then
選択行 = 選択範囲行
End If
Next 選択範囲行
If 選択行 <> 0 Then
Sheets(“写真”).Cells(選択行, 6).Select
UserForm7.Hide
Unload UserForm7
Exit Sub
End If
End Sub
「選択行」は、日記シート上で選択した行。「参照日付」に選択した行の3列目（日付）を代入。写真シートを開き、3列目の値を変数「日付」に代入する。「日付」と「参照日付」が一致するまで「選択範囲行」5行目から65536行目までを検索する。一致したらループを抜けて写真シートの6列目を選択する。
Private Sub CommandButton14_Click() ‘メール送信
Dim 選択行 As Integer
Dim アプリ As Object
Dim メール As Object
Dim 宛先 As String
Dim 件名 As String
Dim 宛名 As String
Dim 日付 As String
Dim 本文 As String
Dim 署名 As String
選択行 = Selection.Row
本文 = Cells(選択行, 6).Value
日付 = Date
宛先 = Sheets(“日付マスター”).Cells(9, 18).Value
件名 = Cells(選択行, 3).Value & ” ” & Sheets(“日付マスター”).Cells(10, 18).Value
宛名 = Sheets(“日付マスター”).Cells(11, 18).Value
If 選択行 > 4 Then
Set アプリ = CreateObject(“Outlook.Application”)
Set メール = アプリ.CreateItem(0)
メール.To = 宛先
メール.Subject = 件名
メール.Body = 宛名 & “ 様” & ” ” & 日付 & Chr(10) & _
Chr(13) & Chr(10) & 本文
メール.Display
Else
MsgBox (” 選択したセルが適当ではありません。やり直してください。”)
End If
End Sub
メール送信ボタンの_Click()イベント。今回のレビューに当たって多少手直しを行なった。日付マスターシートの「覚書フォームのリンク・ボタン設定」に3行の余りがあったので、それぞれ宛先・件名・宛名としてOutlookにリンクしてみたのだ。ExcelからOutlookを操作する方法として参考にしていただければ幸いである。
「エクセル日記」では、毎年の祝祭日を日付マスターに登録するようになっている。以前のカレンダーは、土日に祝祭日が重なった場合に翌週の月曜が振替休日になる、というようなある程度の「法則性」があった。しかし近年ではこういった「法則」とは全く関係なしに振替を行なったり、付け焼き刃で単年限り休日を設けるなど、プログラマー泣かせの休日制度になってしまった。結局、毎年の祝祭日を事前にマスターに登録していく、というのが一番「現実的」な方法であると、私は考えた。さらに、ここが重要なのだが、人によっては、祝祭日ではなくて、実際に自分が会社を休める日を、日記には「赤色表示したい」という人もいるだろう。そのため「エクセル日記」では、祝祭日のマスター登録と並んで、休日変更の機能を追加した。これはデフォルトで赤色表示されている「土・日」の日付を自由に変えられるもので、例えば「日曜日のみ」「月・水」などというふうに変えることを可能にしたものだ。
Private Sub CommandButton1_Click() ‘変更
Dim 休日1 As String
Dim 休日2 As String
Dim 行数 As Integer
Dim 応答 As String
休日1 = UserForm11.ComboBox1.Text
休日2 = UserForm11.ComboBox2.Text
行数 = Range(“AA1”).Value
On Error GoTo errhandler
応答 = MsgBox(” 指定した曜日に定休日を変更します。”, _
vbOKCancel + vbExclamation, “休日変更”)
If 応答 = vbOK Then
ActiveSheet.Unprotect
Cells.Select
Selection.EntireRow.Hidden = False
Selection.EntireColumn.Hidden = False
Range(“C1”).Select
ActiveCell.Value = “=IF(OR($B1=” & 休日1 & ” ,$B1=” & 休日2 & “),1,VLOOKUP($A1,$J$4:$M$2826,4,FALSE))”
Range(“C1”).Select
Selection.Copy
Range(Cells(4, 3), Cells(行数 + 3, 3)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
UserForm11.Hide
Rows(“1:1”).Select
Selection.EntireRow.Hidden = True
Columns(“C:D”).Select
Selection.EntireColumn.Hidden = True
ActiveSheet.Protect
MsgBox ” 変更しました。”
End If
Exit Sub
errhandler:
MsgBox “ 条件は必ず二つ指定してください。一日だけのときは空白（””）を入れてください。”
End Sub
このプロシージャのキモは、次の2行だ。
Range(“C1”).Select
ActiveCell.Value = “=IF(OR($B1=” & 休日1 & ” ,$B1=” & 休日2 & “),1,VLOOKUP($A1,$J$4:$M$2826,4,FALSE))”
デフォルトの計算式である「=IF(OR($B1=”土”,$B1=”日”),1,VLOOKUP($A1,$J$4:$M$2826,4,FALSE))」の土・日を休日変更フォームのComboBox1、ComboBox2の値に変更し、C列にコピーしているのである。変数「行数」は「=COUNTA($A$4:$A$65536)」でAA1セルに入っている。「エクセル日記」のレビューもいよいよ終盤に入ってきた。次は日付マスターシートの入力行削除ボタンである。
日付マスターシートの行削除ボタンのClick()イベント。
Private Sub CommandButton3_Click() ‘行削除
Worksheets(“日記”).Select
UserForm4.Show vbModeless
UserForm4.CommandButton1.Enabled = True
End Sub
押すとすぐに日記シートに移動する。UserForm4（行削除フォーム）はvbModeless。これでフォームを開いたままでシートの選択・スクロールが可能になる。
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Sheets(“日付マスター”).Visible = False
Worksheets(“写真”).Visible = False
Worksheets(“顔”).Visible = False
End Sub
何もせずにフォームを閉じた場合は、そのまま日記シートにとどまる。
Private Sub CommandButton1_Click() ‘実行
Dim 選択行1 As Long
Dim 選択範囲行1 As Long
Dim 参照日付1 As Variant
Dim 日付1 As Date
Dim 選択行2 As Long
Dim 選択範囲行2 As Long
Dim 参照日付2 As Variant
Dim 日付2 As Date
Dim 写真 As Variant
Dim 応答 As Variant
Dim 本日 As Date
On Error GoTo errhandler
If TextBox1 = “” Or TextBox2 = “” Then
Label3 = “削除開始日付と削除終了日付を入れて実行してください。”
MsgBox (” 削除開始日付と削除終了日付を入れて実行してください。 “), vbExclamation
TextBox1.SetFocus
Else
本日 = Sheets(“日記”).Range(“C3”).Text
If TextBox2 > 本日 Then
Label3 = “本日以降の日付は削除できません。”
MsgBox (” 本日以降の日付は削除できません。 “), vbExclamation
Exit Sub
Else
応答 = MsgBox(“指定されたデータ行を削除します。” & _
Chr(13) & Chr(10) & “削除前にデータの印刷、あるいはＰＤＦファイルへの変換・保存をお奨めします。このまま削除してもよろしいですか？”, _
vbYesNo + vbExclamation, “データ行の削除”)
If 応答 = vbYes Then
Label3 = “ただいま削除しています。”
Range(“A2”).Select
ActiveSheet.Unprotect
参照日付1 = TextBox1.Value
参照日付2 = TextBox2.Value
For 選択範囲行1 = 5 To 65536
日付1 = Cells(選択範囲行1, 3).Value
If 日付1 = 参照日付1 Then
選択行1 = 選択範囲行1
End If
Next 選択範囲行1
For 選択範囲行2 = 5 To 65536
日付2 = Cells(選択範囲行2, 3).Value
If 日付2 = 参照日付2 Then
選択行2 = 選択範囲行2
End If
Next 選択範囲行2
Range(Cells(選択行1, 2), Cells(選択行2, 12)).Select
Selection.Delete
Selection.EntireRow.Hidden = True
Worksheets(“写真”).Visible = True
Worksheets(“写真”).Select
ActiveSheet.Unprotect
参照日付1 = TextBox1.Value
参照日付2 = TextBox2.Value
For 選択範囲行1 = 5 To 65536
日付1 = Cells(選択範囲行1, 3).Value
If 日付1 = 参照日付1 Then
選択行1 = 選択範囲行1
End If
Next 選択範囲行1
For 選択範囲行2 = 5 To 65536
日付2 = Cells(選択範囲行2, 3).Value
If 日付2 = 参照日付2 Then
選択行2 = 選択範囲行2
End If
Next 選択範囲行2
Range(Cells(選択行1, 2), Cells(選択行2, 19)).Select
Selection.EntireRow.Hidden = True
ActiveSheet.Protect
TextBox1.Value = “”
TextBox2.Value = “”
Label3.Caption = “”
UserForm4.Hide
Sheets(“日付マスター”).Visible = False
Worksheets(“写真”).Visible = False
Worksheets(“顔”).Visible = False
ActiveSheet.Protect
Range(“A2”).Select
MsgBox ” 削除を完了しました。”
errhandler:
Label3 = “その削除範囲は存在しません。”
TextBox1.SetFocus
If 応答 = vbNo Then
Exit Sub
End If
End If
End If
End If
End Sub
実行ボタンのClick()イベント。削除開始日付と削除終了日付のいずれかが空欄の場合 Label3のCaptionを”削除開始日付と削除終了日付を入れて実行してください。”と表示すると同時に、メッセージボックスも表示する。それ以外の場合で、削除日付が本日より後の場合 Label3のCaptionを”本日以降の日付は削除できません。”と表示すると同時に、メッセージボックスも表示する。どちらもクリアされた場合「参照日付」にTextBox1.Valueの日付を代入する。「選択範囲行」は検索する範囲で、5行目から65536行目まで。その中の3列目（日付）の値を変数「日付」に代入する。「日付」と「参照日付」が一致するまで「選択範囲行」を検索する。一致したらループを抜けて、その行を「選択行」に代入する。この処理を、削除開始日付と削除終了日付それぞれについて行なう。以上によって求めた行を、削除すると同時に非表示とする。
写真シートの日付検索ボタンのClick()イベント。
Private Sub CommandButton2_Click() ‘日付検索
UserForm7.Show vbModeless
UserForm7.TextBox1.SetFocus
End Sub
日付検索フォームをvbModelessで開いている。これでフォームを開いたままでシートの選択・スクロールが可能になる。日付検索フォームのOptionButton1_Click()イベントは本日の行を、CommandButton1_Click()イベントはTextBox1に入力した日付の行へカーソルを飛ばす。
Private Sub CommandButton3_Click() ‘写真挿入
Dim 応答 As Variant
Dim 写真 As Variant
Dim 選択行 As Integer
Dim 選択列 As Integer
選択行 = Selection.Row
選択列 = Selection.Column
応答 = MsgBox(” 写真を挿入するセルはそこでよろしいですか？ “, _
vbYesNo + vbExclamation, “写真挿入”)
If 選択行 > 4 And 選択列 > 4 Then
If 応答 = vbYes Then
MsgBox ” 挿入する写真を選択してクリックしてください。指定したセルに貼り付けます。”
On Error GoTo errhandler
ActiveSheet.Unprotect
Application.Dialogs(xlDialogInsertPicture).Show
For Each 写真 In ActiveSheet.Pictures
写真.Height = 86
写真.Width = 114
Next 写真
With ActiveSheet
.CommandButton1.Height = 21.6
.CommandButton1.Width = 58.8
.CommandButton2.Height = 21.6
.CommandButton2.Width = 58.8
.CommandButton3.Height = 21.6
.CommandButton3.Width = 58.8
.CommandButton4.Height = 21.6
.CommandButton4.Width = 58.8
.CommandButton5.Height = 21.6
.CommandButton5.Width = 58.8
.ToggleButton1.Height = 21.6
.ToggleButton1.Width = 58.8
End With
ActiveSheet.Protect
If 応答 = vbNo Then
Exit Sub
End If
End If
Else
MsgBox (” 選択したセルが適当ではありません。やり直してください。”)
End If
errhandler:
Select Case Err.Number
Case 1004
MsgBox ” その種のファイルを挿入することは出来ません。”
End Select
End Sub
写真シートの写真挿入ボタンのClick()イベント。①選択されたセルに対し” 写真を挿入するセルはそこでよろしいですか？ “とメッセージを表示。②「はい」ボタンを押すと、選択されたセルの位置が4行目より大きく4列目より大きい場合 ” 挿入する写真を選択してクリックしてください。指定したセルに貼り付けます。”のメッセージボックスが出る。③「OK」ボタンを押すと「画像の挿入」ウィンドウが表示される。②の条件をクリアしない場合は (” 選択したセルが適当ではありません。やり直してください。”)とメッセージが表示される。
With ActiveSheet
.CommandButton1.Height = 21.6
.CommandButton1.Width = 58.8
.CommandButton2.Height = 21.6
.CommandButton2.Width = 58.8
.CommandButton3.Height = 21.6
.CommandButton3.Width = 58.8
.CommandButton4.Height = 21.6
.CommandButton4.Width = 58.8
.CommandButton5.Height = 21.6
.CommandButton5.Width = 58.8
.ToggleButton1.Height = 21.6
.ToggleButton1.Width = 58.8
End With
この部分には、少し説明が必要だろう。その直前にある次のコードは、挿入した写真のサイズを、セルに合わせるため縦86：幅114に変更しているコードである。
For Each 写真 In ActiveSheet.Pictures
写真.Height = 86
写真.Width = 114
Next 写真
ところが、実際にこのコードを走らせると、写真のみならずシート上にあるコマンドボタンのサイズまで写真と同じ大きさに変わってしまうのだ。で、それを直すためにコマンドボタンのサイズを元に戻している、というのがWith ActiveSheetから後のコードなのである。面白いので、もし興味がある人がいたらWith～End Withをコメントアウトしてやってみると良い。さて、以上4回に渡って「エクセル日記」のレビューを行なって来た。如何だったであろうか？お付き合い頂いた皆さんには感謝したい。お陰で、細かいバグが見つかったのも、今回のレビューの収穫と言える。修正する良い機会になったと思う。もしご要望があれば、他のソフトについても同様のレビューを行なっても良いかな、と思っている。是非コメントをお寄せ願いたい。