「表示月」を切り替えてみる（ユーザーフォーム） - Infomentのブログ～Excel VBA奮闘記～

昨日は、ようやく単月カレンダーとしての見た目が整ってきた。
infoment.hatenablog.com
昨日の文末にも記載したが、ここまで作ると、前月や翌月への切り替えを行ってみたくなる。そこで今日は、それに挑戦した。
f:id:Infoment:20181128224418p:plain

どうやって切り替えるか色々と思案したが、新たに「▲」と「▼」のラベルを追加して対応することにした。
f:id:Infoment:20181128224707p:plain

試行錯誤していたら23時になってしまった。今日はもう、時間切れ。できたところまで載せることにする。

標準モジュール

切り替えに用いる、前月と来月用変数を宣言。

Option Explicit
    Public LastMonth As Date
    Public NextMonth As Date

ユーザーフォーム

上記で宣言した前月と来月に、とりあえず日付を入れる。欲しいのは「〇年×月」までなので、とりあえず今日を基準にして前月と来月とする。

Private Sub UserForm_Initialize()
    Dim i As Long
    Dim myCmdBtn As MSForms.CommandButton
    Set myCol = New Collection
    
    Dim my1stDay As Date
        my1stDay = DateSerial(Year(Date), Month(Date), 1)
    Dim myDate As Date
        myDate = my1stDay - WorksheetFunction.Weekday(my1stDay, vbMonday)

    For i = 1 To 42
        Set myCmdBtn = Me.Controls.Add("Forms.CommandButton.1", _
                                               "CommandButton" & i, True)
        With myCmdBtn
            .Left = Me.Width * Rnd * 0.9
            .Top = Me.Height * Rnd * 0.9
            .Width = ButtonSize
            .Height = ButtonSize
            .Caption = Day(myDate)
            .BackColor = myBackColor(myDate)
            .ForeColor = myFontColor(myDate)
        End With
        Set myCls = New Class1
        myCls.setBtn myCmdBtn, myDate, i
        myCol.Add myCls
        myDate = myDate + 1
    Next
    
    ' 今回の追加個所。
    LastMonth = WorksheetFunction.EDate(Date, -1)
    NextMonth = WorksheetFunction.EDate(Date, 1)
    
    myFlag = False
    
End Sub

昨日作成した、ラベルセット用のサブプロシージャを修正して、「▼」と「▲」も追加。ついでに、この二つをクリックした際のイベントも追加する。

Private Sub SetLabel()
    Dim i As Long
    Dim myLabel As MSForms.Label
    
    ' 今回の修正箇所。
    ' 日曜日～土曜日。
    Dim Seq As Variant
        Seq = Array("日", "月", "火", "水", "木", "金", "土", "", "▲", "▼")
    
    For i = 1 To 7
        Set myLabel = Me.Controls.Add("Forms.Label.1", _
                                      "Label" & i, _
                                      True)
        With myLabel
            .Left = Left_Start + ButtonSize / 4 + (i - 1) * ButtonSize
            .Top = Top_Start
            .Width = ButtonSize
            .Height = ButtonSize
            .Caption = Seq(i - 1)
            Select Case i
                Case 1: .ForeColor = &HC0
                Case 7: .ForeColor = &HFF0000
            End Select
        End With
    Next
    
    ' YYYY年MM月
    Set myLabel = Me.Controls.Add("Forms.Label.1", _
                                  "Label8", _
                                  True)
    With myLabel
        .Left = Left_Start + ButtonSize / 4
        .Top = Top_Start - ButtonSize
        .Height = ButtonSize
        .Caption = StrConv(Format(Date, "YYYY年MM月"), vbWide)
    End With
    
    ' 今回の追加個所。
    ' ▼▲ボタン代わり。
    For i = 9 To 10
        Set myLabel = Me.Controls.Add("Forms.Label.1", _
                                    "Label" & i, _
                                    True)
        With myLabel
            .Left = Left_Start + ButtonSize / 4 + (i - 5) * ButtonSize
            .Top = Top_Start - ButtonSize
            .Height = ButtonSize
            .Caption = Seq(i - 1)
        End With
        Set myCls = New Class1
        myCls.SetLabel myLabel, CStr(Seq(i - 1))
        myCol.Add myCls
    Next
End Sub

クラスモジュール

最後にWithEventsで、▲と▼のラベルがクリックされたことを検知し、〇年×月の表示を前後させる。

Option Explicit
Private WithEvents myCmdBtn As MSForms.CommandButton
Public myDate As Date
Public myIndex As Long
' ↓今回の追加個所↓
Private WithEvents myLabel As MSForms.Label
Public myDirection As String

Sub SetLabel(Label_ As MSForms.Label, Direction_ As String)
    Set myLabel = Label_
    myDirection = Direction_
End Sub

Private Sub myLabel_Click()
    Select Case myDirection
        Case "▲"
            UserForm1.Controls("Label8").Caption = StrConv(Format(LastMonth, "YYYY年MM月"), vbWide)
            LastMonth = WorksheetFunction.EDate(LastMonth, -1)
            NextMonth = WorksheetFunction.EDate(NextMonth, -1)
        Case "▼"
            UserForm1.Controls("Label8").Caption = StrConv(Format(NextMonth, "YYYY年MM月"), vbWide)
            LastMonth = WorksheetFunction.EDate(LastMonth, 1)
            NextMonth = WorksheetFunction.EDate(LastMonth, 1)
    End Select
End Sub