ウィジェット風カレンダーフォームの表示 | エクセルマクロ(VBA)実践蔵(じっせんぐら)
- エクセルマクロ(VBA)実践蔵 >
- 項目一覧 >
- ウィジェット風カレンダーフォームの表示
ウィジェット風カレンダーフォームの表示最終更新日：2023-06-13
エクセルのユーザフォーム(自作カレンダー)に予定を書き込んで、ウィジェット風に表示させよう
下記の関連記事２つのマクロを合わせて、エクセルのカレンダーで設定した予定をユーザフォームのカレンダでマウスを日付に重ねたときに予定が表示されるようにしていきたいと思います。
そのうえで、起動方法をVBS(Visual Basic Script)からの起動に変え、PC右上にカレンダーが常駐できるようにします。また、カレンダーの日付をクリックするとクリップボードにコピーされ、テキストエディタやWordファイルなどに貼り付けできるようにしていきたいと思います。
ユーザが書き込むカレンダー(マクロによる生成)
カレンダーを生成する手順は、こちらを参照してください。
ユーザフォームで作る自作のカレンダーフォームに予定を表示させる
マウスオーバーによる予定の表示。マウスの位置が画像に出ていませんが、左側が5日にカーソルをあわせたもので、右側が6日に合わせたものです。残念ながら改行の表示はできません。上の画像に登録した予定が下の画像で表示されています。
また、「予定を記入」ボタンで、予定を記入しているエクセルファイルが開きます。
エクセルが開いている時には、「予定を閉じる」ボタンをつけています。閉じるボタンを押すと、エクセルは非表示になります。
予定を記入後、ウィジット風カレンダーフォームへデータを反映させるには、入力した月を表示させるだけで済みます。例えば、ウィジット風カレンダーフォームが2023年6月を表示していて、エクセルのカレンダーへ2023年6月の予定を追加した場合は、ウィジット風カレンダーフォーム上で別の月(5月や7月)を表示させて、再度6月を表示させれば、反映されます。
注意事項になりますが、他にエクセルファイルが開いていた場合は、他のファイルを閉じるまで、編集中のカレンダーを含むエクセルファイルは「予定を閉じる」ボタンによって閉じられません。「予定を閉じる」ボタンを使わずに、カレンダーのエクセルを手動で×ボタンによって終了するとカレンダーも閉じられます。
カレンダーフォームの日付をクリックすると、クリップボードに日付(yyyy/mm/dd)形式で保存します。
windowsに搭載されているクリックボード機能を有効にしていない場合は、WindowsマークとVボタンを同時に押して、有効にしてください。
下記は、13日をクリックした場合の画像です。
スクリプトからの起動と手動による起動の違い
通常エクセルを複数ファイル開くと、エクセルという大枠の中に複数ファイルが入ります。大枠をエクセルのアプリケーションとした場合、その中で、複数のブックがオープンされている状態になりますが、スクリプトから起動すると、この大枠のエクセルが別で起動されます。つまり、手動で起動するエクセルとは切り離されて、単独で存在するエクセルアプリケーションとなります。
この単独で存在するエクセルアプリケーションに対して、ユーザフォームを表示後に、非表示になるように設定することでウィジェットのように表示させています。
マクロの実行からの手動で起動したまま、他のエクセルブックを開くと、少し時間がかかります。通常、アプリケーションを非表示にすることはないため、その影響だと思います。影響範囲が把握しきれないため、あまり、手動によるカレンダーの起動後に別のエクセルを開かないようにしてください。
マクロの動作確認を行う場合は、スクリプトから起動後、「予定の記入」ボタンからエクセルファイルを表示させ、Visual Basic Editor画面を表示させてください。
マクロの説明
ユーザフォームにラベルとボタンを追加
カレンダーの末尾にラベルを追加。クリップボードへのコピーが完了した場合にメッセージを出力する。
追加したラベルのオブジェクト名は、プロパティウィンドウからMsgLabelに変更する。Captionは空欄にする。
「予定を記入」「予定を閉じる」ボタンの２つを追加する。「予定を記入」ボタンのオブジェクト名を「予定記入Btn」に変更し、Captionに「予定を追加」を設定する。「予定を閉じる」ボタンのオブジェクト名は、「予定閉じるBtn」に変更し、Captionに「予定を閉じる」を設定する。また、VisibleをFalseにしておく。「予定を閉じる」ボタンは、「予定を開く」ボタンが押されてエクセルが起動しているときだけ、表示させるようにしています。
ラベルの初期化処理
CalenderFormオブジェクトに記述します。
'マウスが動いたら、追加したラベルのCaptionを初期化します
'いつまでも「クリップボードにコピーしました」を出さないための措置
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgLabel.Caption = ""
End Sub
「予定を記入」ボタンが押下されたときの処理
CalenderFormオブジェクトに記述します。
'「予定を記入」するボタン押下時の処理
Private Sub 予定記入Btn_Click()
Dim sht As Worksheet
Dim findFlg As Boolean
'カレンダーシートを探すフラグの初期化
findFlg = False
'予定を閉じるボタン(エクセルを非表示にするボタン)を表示させる
予定閉じるBtn.Visible = True
'予定を開くボタンを非表示にする
予定記入Btn.Visible = False
'エクセルファイルを表示する
If Windows.Count = 0 Then
'スクリプト以外から手動でカレンダーを起動し、
'他のエクセルのOpen/Close後に陥る想定外ルート
'スクリプトからの起動を推奨します。
ThisWorkbook.Application.Visible = True
ElseIf Windows.Count = 1 Then
'スクリプトから起動した場合の正常ルート
'カレンダーの起動時に、下記をFalseにしているので元に戻す
ThisWorkbook.Application.Visible = True
Windows(ThisWorkbook.Name).Visible = True
End If
'全シートの中から該当カレンダーシートを探す
For Each sht In ThisWorkbook.Worksheets
'シート名が一致する場合
If sht.Name = Year(disp_day) & "年" & Month(disp_day) & "月" Then
'見つけたフラグを立てる
findFlg = True
'見つけたシートを正面にする
sht.Activate
End If
Next
'カレンダーが存在しない場合
If findFlg = False Then
'実行シートを表示させる
Worksheets("実行").Activate
End If
End Sub
「予定を記入」ボタンが押下されたときの処理の解説
スクリプトからの起動と手動による起動の違いの影響による対処を入れています。「予定を閉じる」ボタンが押下されたときの処理
CalenderFormオブジェクトに記述します。
'予定を閉じるボタンが押下されたときの処理
Private Sub 予定閉じるBtn_Click()
'エクセル内に他のブックを開いていない
If Workbooks.Count = 1 Then
If Windows.Count = 0 Then
'スクリプト以外から手動でカレンダーを起動し、
'他のエクセルのOpen/Close後に陥る想定外ルート
'スクリプトからの起動を推奨します。
ThisWorkbook.Application.Visible = False
ElseIf Windows.Count = 1 Then
'スクリプトから起動した場合の正常ルート
Windows(ThisWorkbook.Name).Visible = False
ThisWorkbook.Application.Visible = False
End If
'「予定を記入」ボタン「予定を閉じる」ボタンの表示非表示を変更
CalenderForm.予定記入Btn.Visible = True
CalenderForm.予定閉じるBtn.Visible = False
Else
MsgBox "他のエクセルが開いているため、エクセルを非表示にできませんでした。" & vbCrLf & "予定を閉じるボタンから閉じてください。"
End If
End Sub
「予定を閉じる」ボタンが押下されたときの処理の解説
スクリプトからの起動と手動による起動の違いの影響による対処を入れています。カレンダフォームに月情報を設定する関数
CalenderFormオブジェクトに記述します。
下記は、カレンダーフォームの月情報を設定する関数に、今回の対処のため、コードを追加しています。（☆マーク位置）
'カレンダフォームに月情報を設定する関数
Function SetMonthDate(disp_year As Integer, disp_month As Integer)
Dim t_week As Integer
Dim t_end_date As Date
Dim t_end As Integer
Dim cnt As Integer
Dim set_day As Integer
Dim daySchedule As String
'年月表示ラベルに設定
MonthLabel.Caption = disp_year & "年" & disp_month & "月"
disp_day = disp_year & "/" & disp_month & "/1"
'一日の曜日
t_week = Weekday(disp_year & "/" & disp_month & "/" & 1)
'DayLabel1～t_week-1までに空白を設定
For cnt = 1 To t_week - 1
With CalenderForm.Controls("DayLabel" & cnt)
.Caption = ""
End With
Next
'DateSerial(2017, 10, 0) → 2017/09/30（自動調整された）
'末日の取得
t_end_date = DateSerial(disp_year, disp_month + 1, 0)
t_end = Day(t_end_date)
'ラベルの最後
t_end = t_end + t_week - 1
'ラベルへ日にちの設定
set_day = 1
For cnt = t_week To t_end
With CalenderForm.Controls("DayLabel" & cnt)
.Caption = set_day
End With
'色の設定
'日付のフォントカラーを変更するように追加対応
Call SetFontColor(cnt, DateSerial(disp_year, disp_month, set_day))
'↓ここから変更箇所☆
'エクセルカレンダーから登録した情報を受け取る
daySchedule = readSchedule(DateSerial(disp_year, disp_month, set_day))
With CalenderForm.Controls("DayLabel" & cnt)
'ヒントの表示機能(コントロールチップ)を使用して予定を設定する
.ControlTipText = daySchedule
End With
'↑ここまで変更箇所☆
'今日と一致
If Year(Now) = disp_year Then
If Month(Now) = disp_month Then
If Day(Now) = set_day Then
With CalenderForm.Controls("DayLabel" & cnt)
.BorderStyle = fmBorderStyleSingle
.BackColor = RGB(CInt("&H" & "FF"), CInt("&H" & "F1"), 0)
End With
End If
End If
End If
set_day = set_day + 1
Next
'残ったラベルに空欄設定
For cnt = t_end + 1 To 42 'ラベル定義最後
With CalenderForm.Controls("DayLabel" & cnt)
.Caption = ""
End With
Next
End Function
カレンダフォームに月情報を設定する関数の解説
readScheduleは、標準モジュールに記述します。
カレンダフォームを×ボタンで閉じるときの動作
CalenderFormオブジェクトに記述します。
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'Formが閉じるとき
If CloseMode = 0 Then '×ボタンを押された場合
Unload Me
'↓下記を今回追加☆
Application.Quit
ThisWorkbook.Close
'↑追加はここまで☆
End If
End Sub
ここまでが、CalenderFormオブジェクトへの追加措置です。
日付ラベルクリック時の動作マクロ
クラスモジュールDayLabelClass内のDayLabels_Click内でも変更を行います。
'******************************
' ラベルがクリックされたとき
'******************************
Private Sub DayLabels_Click()
Dim select_year As Integer
Dim select_month As Integer
Dim cbData As New DataObject
'現在カレンダーで表示している年月を取得
select_year = Year(CalenderForm.disp_day)
select_month = Month(CalenderForm.disp_day)
'クリックされたラベルに値(数字)がある場合
If Not DayLabels.Caption = "" Then
'今回追加 ここから☆
'選択中のセルに日付情報を設定
cbData.SetText select_year & "/" & select_month & "/" & DayLabels.Caption
'クリップボードに格納
cbData.PutInClipboard
CalenderForm.MsgLabel.Caption = "クリップボードにコピーしました"
'今回追加 ここまで☆
'今回削除 ここから☆
'選択中のセルに日付情報を設定
'ActiveCell.Value = select_year & "/" & select_month & "/" & DayLabels.Caption
'カレンダーを非表示にしないで表示したままにする
'CalenderForm.Hide
'今回削除 ここまで☆
End If
End Sub
日付ラベルクリック時の動作マクロの解説
ActiveCellへの書き出しを削除し、クリップボードに登録しています。また、ユーザにコピーしたことを伝えるために、ラベルに「クリップボードにコピーしました」を表示させています。
標準モジュールへの追加
カレンダーを起動する処理
標準モジュールに記述しているカレンダーフォーム表示の関数に☆部分を追加する。
Public Sub calender_show()
'カレンダーフォームの呼び出し
CalenderForm.Show vbModeless
'↓今回の追加箇所ここから☆
If workbooks.Count = 1 Then
If Windows.Count = 0 Then
'スクリプト以外から手動でカレンダーを起動し、
'他のエクセルのOpen/Close後に陥る想定外ルート
'スクリプトからの起動を推奨します。
ThisWorkbook.Application.Visible = False
ElseIf Windows.Count = 1 Then
'スクリプトから起動した場合の正常ルート
Windows(ThisWorkbook.Name).Visible = False
ThisWorkbook.Application.Visible = False
Endif
Else
MsgBox "他のエクセルが開いているため、エクセルを非表示にできませんでした。" & vbCrLf & "予定を閉じるボタンから閉じてください。"
'「予定を記入」ボタンと「予定を閉じる」ボタンの初期値を変更
CalenderForm.予定記入Btn.Visible = False
CalenderForm.予定閉じるBtn.Visible = True
End If
'↑今回の追加箇所ここまで☆
End Sub
カレンダーを起動する処理の解説
スクリプトからの起動と手動による起動の違いの影響による対処を入れています。スクリプトからの起動であれば、メッセージボックスは表示されません。
エクセルカレンダーから予定を取得するマクロ
Function readSchedule(DayInfo As Date) As String
Dim sht As Worksheet
Dim yearDigit As Long, monthDigit As Long
Dim startWeek As Integer
Dim offset As Long, StRow As Long
Dim diff As Long
Dim 列数 As Long, 行数 As Long
Dim dayCnt As Long
Dim dayDigit As Long
'戻り値の初期化
readSchedule = ""
'カレンダーシートを探す
For Each sht In ThisWorkbook.Worksheets
yearDigit = CInt(Year(DayInfo))
monthDigit = CInt(Month(DayInfo))
'カレンダーの開始位置がB列のため、Offsetで位置補正
offset = 1
If sht.Name = yearDigit & "年" & monthDigit & "月" Then
'シートが見つかった場合
'一日(ついたち)の曜日(数値)を受け取る
startWeek = Weekday(yearDigit & "/" & monthDigit & "/" & 1)
'vbSunday 1 日曜日 (既定)
'vbMonday 2 月曜日
'vbTuesday 3 火曜日
'vbWednesday 4 水曜日
'vbThursday 5 木曜日
'vbFriday 6 金曜日
'vbSaturday 7 土曜日
'曜日(数値)にOffset(1)を加算して記入すべき列数を計算する
列数 = Weekday(DayInfo) + offset
'Modは余りの計算。一日(ついたち)の曜日前までの日数。
'計算結果がマイナスにならないように7を足しておく
diff = (vbSunday + 7 - startWeek) Mod 7
'開始行数を設定
StRow = 4
'書き込む行数を求める。第何週目か。
'一日(ついたち)の曜日前までの日数も加算しておく
'CIntはキャスト、Intは小数点以下切り捨て
行数 = Int((CInt(Day(DayInfo)) + diff) / 7) * 2 + StRow
'セルから予定を取得する(関数の戻り値とする)
readSchedule = sht.Cells(行数, 列数).Value
Exit For
End If
Next
End Function
エクセルカレンダーから予定を取得するマクロの解説
引数の日付情報から、参照するシートを特定して、予定が入っているセルの位置を計算して、セルに入っている予定情報を戻り値として返します。
スクリプトのコード
テキストエディタを開き、下記を貼り付けます。「ShowCalendar.vbs」のように「.vbs」の拡張子をつけて保存します。名前は変えても問題ありません。拡張子を表示していないPCの場合は、「.vbs.txt」にならないように気を付けてください。「.vbs」は、エクスプローラ上で表示されるファイルの種類は、下記のようにVBS Script Scriptファイルとなります。
Dim FSO
Dim MyPath
Dim objExcel
On Error Resume Next
On Error GoTo 0
Set FSO = CreateObject("Scripting.FileSystemObject")
' スクリプト格納フォルダパスの取得
MyPath = FSO.getParentFolderName(WScript.ScriptFullName)
' Excelのオブジェクトを作成する
Set objExcel = CreateObject("Excel.Application")
'Excelを起動
objExcel.Workbooks.Open(MyPath & "/Weditcalendar.xlsm")
objExcel.Application.Visible = TRUE
'カレンダーを表示
objExcel.Application.Run "calender_show"
'終了処理
Set objExcel = Nothing
スクリプトのコード解説
スクリプトのフォルダパスを取得し、開くエクセルファイルのパスに使用しています。
エクセルの中の標準モジュールに記載している関数calender_showの実行を行っています。
エクセルマクロ有効ブックのダウンロード
下記、スクリプトとエクセルは同じフォルダに格納してください。
ダウンロードしたエクセルファイルを起動し、コンテンツの有効化を行う。
マクロの有効化手順については、こちら「マクロの初期設定と基本」も参考にしてください。
スクリプトをダブルクリックすると、カレンダーが起動します。(スクリプト起動を推奨しますが、エクセルファイルを開いて、マクロの実行からでも呼び出せます。）