ExcelVBA自作カレンダーコントロールへ祝日・休日設定する

11件のコメント

1. teru より:

   2017年6月4日 12:24 PM

   休日リストのA列にだけ日付を入れて休日指定したいのですが
   どのようにしたら良いかご教示頂けますでしょうか？

   返信
   • *you より:

     2017年6月5日 1:56 PM

     teruさん、コメントありがとうございます。「休日リスト」シートから休日を検索する部分を、

     With Sheets("休日リスト")
       Set fnd = .Columns("A").Find(CDate(yy & "/" & mm & "/" & i)) '検索
       If Not fnd Is Nothing Then '見つかったら
         Me("Label" & i + n).ForeColor = RGB(255, 0, 0) '赤
       End If
     End With
     

     こうすればいいんじゃないかなーと思います。

2. teru より:

   2017年6月7日 1:49 PM

   ありがとうございます。
   ちょっと気になる点がありまして、コンボボックスで西暦を手入力すると
   追加したSet fndの行でエラーになってしまいます。
   使用には差し支えないのですが何がいけないのでしょうか？
   DLした方は問題ないです（4桁まで）

   返信
   • *you より:

     2017年6月8日 12:34 PM

     ああー、コンボボックスの手入力は考えてなかったです。.Findは日付の検索に不安定な動きをすることがあるので、それかもしれませんね。A列の最終端を取得して、ループで回すほうが確実かもしれません。

     昔書いたコードなので宣言とかイケてないなと思って、プロシージャごと書き直してみました。

     Private Sub clndr_set() 'カレンダーの作成と表示
       Dim i As Integer
       Dim ws As Worksheet: Set ws = Sheets("休日リスト")
       
       If Me.ComboBox1 = "" Or Me.ComboBox2 = "" Then Exit Sub '年か月どちらか入ってなければ中止
       Dim yy As Integer: yy = Me.ComboBox1 '年
       Dim mm As Integer: mm = Me.ComboBox2 '月
         
       For i = 1 To 37 'ラベルの初期化
         Me("Label" & i).Caption = ""
         Me("Label" & i).BackColor = Me.BackColor
         If i Mod 7 = 1 Then '日曜
           Me("Label" & i).ForeColor = RGB(255, 0, 0) '赤
         ElseIf i Mod 7 = 0 Then '土曜
           Me("Label" & i).ForeColor = RGB(0, 0, 255) '青
         Else 'それ以外
           Me("Label" & i).ForeColor = RGB(0, 0, 0) '黒
         End If
       Next
       
       Dim n As Integer: n = Weekday(yy & "/" & mm & "/" & 1) - 1 'その月の1日の曜日番号に、マイナス1したもの
       Dim endDay As Integer: endDay = Day(DateAdd("d", -1, DateAdd("m", 1, yy & "/" & mm & "/" & "1"))) '月末日の算出
       Dim lastRow As Long: lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row '休日リストの最終行
       Dim holiRow As Long
       
       For i = 1 To endDay
         Me("Label" & i + n).Caption = i '日を入れる
         If CDate(yy & "/" & mm & "/" & i) = clndr_date Then Me("Label" & i + n).BackColor = RGB(200, 200, 200) 'TextBoxの日と同じなら色をつける
         For holiRow = 1 To lastRow
           If ws.Cells(holiRow, 1) = CDate(yy & "/" & mm & "/" & i) Then '見つかったら
             Me("Label" & i + n).ForeColor = RGB(255, 0, 0) '赤
             Exit For
           End If
         Next holiRow
       Next i
     End Sub
     

     これで動くと思います。ただ、コンボボックスに4桁より大きい数値を入れるとか、文字列入れちゃうとか、そういうエラー処理はしておりませんのでご了承ください。

3. teru より:

   2017年6月10日 6:15 PM

   教えて頂きましたコードにて業務で使える最高の
   カレンダーツールとなりました。
   分かりやすくてとても参考になります。
   ありがとうございました。

   返信
   • *you より:

     2017年6月12日 12:22 PM

     お役に立てまして光栄ですー！　(*´∀｀)　コンボボックスに日付として認識されない数や文字列が直接入力された場合のエラー処理、気になったので追記しました。

     • ExcelVBAでカレンダーコントロールを自作する

     こちらのページのコメント欄に書きましたので、ご参照ください。

4. Mimi より:

   2017年8月18日 12:30 PM

   とても分かりやすいご説明で、助かりました。form1をアレンジし、オプションボタンとコマンドボタン、フレームで、異なる国のカレンダーを表示できるようになりました。気になるのは、祝日のフォントのみ太字にどうにか設定できないかな、ラベルクリックで何の祝日なのかを表示できないかと模索しています。

   返信
   • *you より:

     2017年8月21日 7:59 PM

     Mimiさん、コメントありがとうございます。本文中に示したマトリクス状の「休日リスト」で、休日のセルに「1」の代わりに「祝日の名称」が入っているものと仮定すると、こんな感じでしょうか。

     Private Sub clndr_set() 'カレンダーの作成と表示
       Dim i As Integer
       Dim ws As Worksheet: Set ws = Sheets("休日リスト")
       
       If Me.ComboBox1 = "" Or Me.ComboBox2 = "" Then Exit Sub '年か月どちらか入ってなければ中止
       Dim yy As Integer: yy = Me.ComboBox1 '年
       Dim mm As Integer: mm = Me.ComboBox2 '月
         
       For i = 1 To 37 'ラベルの初期化
         Me("Label" & i).Caption = ""
         Me("Label" & i).BackColor = Me.BackColor
         Me("Label" & i).Bold = False
         Me("Label" & i).Tag = ""
         If i Mod 7 = 1 Then '日曜
           Me("Label" & i).ForeColor = RGB(255, 0, 0) '赤
         ElseIf i Mod 7 = 0 Then '土曜
           Me("Label" & i).ForeColor = RGB(0, 0, 255) '青
         Else 'それ以外
           Me("Label" & i).ForeColor = RGB(0, 0, 0) '黒
         End If
       Next
       
       Dim n As Integer: n = Weekday(yy & "/" & mm & "/" & 1) - 1 'その月の1日の曜日番号に、マイナス1したもの
       Dim endDay As Integer: endDay = Day(DateAdd("d", -1, DateAdd("m", 1, yy & "/" & mm & "/" & "1"))) '月末日の算出
       
       For i = 1 To endDay
         Me("Label" & i + n).Caption = i '日を入れる
         If CDate(yy & "/" & mm & "/" & i) = clndr_date Then Me("Label" & i + n).BackColor = RGB(200, 200, 200) 'TextBoxの日と同じなら色をつける
         Dim fnd As Range: Set fnd = ws.Range("A2:A1000").Find(yy) '年を検索
         If Not fnd Is Nothing Then '見つかったら
           If ws.Cells(fnd.Row + mm - 1, i + 2) <> "" Then
             Me("Label" & i + n).ForeColor = RGB(255, 0, 0) '赤
             Me("Label" & i + n).Font.Bold = True '太字
             Me("Label" & i + n).Tag = ws.Cells(fnd.Row + mm - 1, i + 2) 'セル内容をタグに登録
           End If
         End If
       Next i
     End Sub
     

     ラベルコントロールのTagというプロパティに、セルの内容を入れておきます。あとは、クリックで走るプロシージャにて

     Private Sub LabelClick(ByVal i As Integer)
       If Me("Label" & i).Caption = "" Then Exit Sub 'ラベルが空だったら中止
       If Me("Label" & i).Tag <> "" Then MsgBox Me("Label" & i).Tag 'タグがあったらメッセージボックスで表示
       clndr_date = Me.ComboBox1 & "/" & Me.ComboBox2 & "/" & Me("Label" & i).Caption '日付を生成して変数に格納
       clndr_flg = True 'フラグを立てる
       Unload Me 'カレンダーを閉じる
     End Sub
     

     このように、該当ラベルコントロールのTagの内容をメッセージボックスで表示できます。

5. Mimi より:

   2017年8月29日 6:10 PM

   ありがとうございます。残念ながらまだ休日表示ができていません。フォーム1のUIを変更したのが原因なのかと思い、1から組み直してみたりしていますが実装にいたっておりません。

   返信
6. 伊藤　穣 より:

   2020年10月6日 10:22 AM

   素晴らしいコードの提供ありがとうございます。とても使いやすいです。
   dtpickerがなくなり途方に暮れておりました。

   返信
   • *you より:

     2020年10月7日 5:17 AM

     伊藤さん、コメントありがとうございます。お役に立ててとっても嬉しいです！

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください。

コメントは承認制ですので、反映までしばらくお待ち下さい。（稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。）

YouTubeでQ&Aコンテンツを企画しています

運営しているYouTubeチャンネルで、ご相談やご質問を募集しています。動画のコメントやお問い合わせページからお気軽にご相談をお寄せください。