切り替えた表示月に合わせて、ボタンの表示も変更する（ユーザーフォーム）

昨日は、単月カレンダーの一行目にある「〇月×日」だけを切り替えるところまで作成した。
infoment.hatenablog.com
そこで今日は、切り替えた「〇月×日」表記に合わせて、ボタンの表示変更に挑戦する。
f:id:Infoment:20181129221712p:plain

結論から先に申し上げると、今回の試みはブログとして失敗だ。なぜなら、試行錯誤を繰り返すうちに、どこをどういじったか説明できないほど変更してしまったから。従って、結果しかお伝え出来ないものになってしまった。

とりあえず、自分で再現したい方がおられた場合に備えて、今日は現状のコードを丸々掲載することにする。

クラスモジュール（Class1）

取り敢えず、クラスモジュールの挿入で付される名前のままとしてある。その方が、一から作る場合に簡単だから。

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

Private Sub myCmdBtn_Click()
    MsgBox myDate
End Sub

Sub setBtn(Cmdbtn As MSForms.CommandButton, Date_ As Date, Index_ As Long)
    Set myCmdBtn = Cmdbtn
    myDate = Date_
    myIndex = Index_
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(NextMonth, 1)
    End Select
    my1stDay = DateSerial(Year(LastMonth), Month(LastMonth) + 1, 1)
    Call UserForm1.SetDate
End Sub

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

標準モジュール（名前：不問）

ここでは、Public変数の宣言のみを行っている。

Option Explicit
    Public LastMonth As Date
    Public NextMonth As Date
    Public my1stDay As Date

ユーザーフォーム（UserForm1）

ユーザーフォームの名前も、挿入で作成する一つ目のユーザーフォーム名称のままとした。

Option Explicit
    Const ButtonSize As Double = 20
    Const Left_Start As Double = 10
    Const Top_Start As Double = 35
    Dim myButtonCol As Collection
    Dim myLabelCol As Collection
    Dim myCls As Class1
    Dim myFlag As Boolean

Private Sub UserForm_Initialize()
    Dim i As Long
    Dim myCmdBtn As MSForms.CommandButton
    Set myButtonCol = New Collection
    Set myLabelCol = New Collection
    
    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
        End With
    Next
    
    my1stDay = DateSerial(Year(Date), Month(Date), 1)
    Call SetDate

    LastMonth = WorksheetFunction.EDate(Date, -1)
    NextMonth = WorksheetFunction.EDate(Date, 1)    
    myFlag = False    
End Sub

Private Sub UserForm_Click()
    If myFlag = True Then Exit Sub
    Dim i As Long
    Dim myControl As Control
    Dim j As Long
    Dim jMax As Long
        jMax = 100
    Dim dx(1 To 42) As Double
    Dim dy(1 To 42) As Double

    i = 1
    For Each myControl In Me.Controls
        With myControl
            dx(i) = (.Left - Locate(i)(0)) / jMax
            dy(i) = (.Top - Locate(i)(1)) / jMax
            i = i + 1
        End With
    Next

    For j = 1 To jMax - 1
        i = 1
        For Each myControl In Me.Controls
            With myControl
                .Left = .Left - dx(i)
                .Top = .Top - dy(i)
                i = i + 1
            End With
        Next
        Application.Wait [now()+"0:00:00.001"]
    Next
    
    i = 1
    For Each myControl In Me.Controls
        myControl.Left = Locate(i)(0)
        myControl.Top = Locate(i)(1)
        i = i + 1
    Next
    jMax = jMax - 1
    myFlag = True
    
    Call SetLabel
End Sub

Public Sub SetDate()
    Dim myControl As Control
    Dim myDate As Date
        myDate = my1stDay - WorksheetFunction.Weekday(my1stDay, vbMonday)
    Dim i As Long
        i = 1
    Set myButtonCol = New Collection
        For Each myControl In Me.Controls
            If TypeName(myControl) = "CommandButton" Then
                With myControl
                    .Caption = Day(myDate)
                    .BackColor = myBackColor(myDate)
                    .ForeColor = myFontColor(myDate)
                End With
                Set myCls = New Class1
                myCls.setBtn myControl, myDate, i
                myButtonCol.Add myCls
                myDate = myDate + 1
                i = i + 1
            End If
        Next
End Sub

Private Property Get HolidayDict() As Dictionary
    Dim HolidayTable As ListObject
    Set HolidayTable = Sheets("勤休シート").ListObjects(1)
    
    'Microsoft Scripting Runtime 参照設定済み
    Dim TempDict As Dictionary
    Set TempDict = New Dictionary
    
    Dim r As Range
    For Each r In HolidayTable.DataBodyRange.Columns(1).Cells
        TempDict(r.Value) = r.Offset(, 1).Value
    Next
    
    Set HolidayDict = TempDict
    
End Property

Private Property Get Locate() As Variant
    Dim Seq(1 To 42) As Variant
    Dim i As Long
        For i = 1 To UBound(Seq)
            Seq(i) = Array(Left_Start + ButtonSize * ((i - 1) Mod 7), _
                           Top_Start + ButtonSize * WorksheetFunction.RoundUp(i / 7, 0))
        Next
        Locate = Seq
End Property

Private Function myBackColor(myDate As Date) As Double
    Dim TargetMonth As Long
        TargetMonth = Month(myDate)
    Dim ThisMonth As Long
        ThisMonth = Month(my1stDay + 7)
        
    If TargetMonth = ThisMonth Then
        myBackColor = &HFFFFFF
    Else
        myBackColor = &HC0C0C0
    End If
    
    If myDate = Date Then
        myBackColor = &HC0&
    End If
End Function

Private Function myFontColor(myDate As Date) As Double
    Select Case WorksheetFunction.Weekday(myDate)
        Case vbSunday:   myFontColor = &HC0
        Case vbSaturday: myFontColor = &HFF0000
        Case Else:       myFontColor = &H80000012
    End Select
    
    If HolidayDict.Exists(myDate) Then
        Select Case HolidayDict(myDate)
            Case "休日": myFontColor = &HC0
            Case "出勤": myFontColor = &H80000012
        End Select
    End If
    
    If myDate = Date Then
        myFontColor = &HFFFF&
    End If
End Function

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, myLabel.Caption
        myLabelCol.Add myCls
    Next
End Sub