ボタンに色を付けてみる

昨日は、ユーザーフォーム上のボタンを使って、11月のカレンダーを作成した。
infoment.hatenablog.com
ただし昨日は見た目、曜日などが良く判らないままだった。そこで今回は、曜日などの見える化を行ってみる。

今回は、色分けによる見える化を行う。

1. 当月か前後月か。
2. 平日か土日か。
3. 当日か否か。

なお、今回は土曜日を青色、日曜日を赤色の文字で示している。各コマンドボタンについて、変更するのは以下の２つだ。

プロパティ	内容
FontColor	文字色
BackColor	背景色

背景色、文字色について共に、ボタンが示す日付を引数としたユーザー定義関数を作成した。

ユーザーフォーム

Private Function myBackColor(myDate As Date) As Double
    Dim TargetMonth As Long
        TargetMonth = Month(myDate)
    Dim ThisMonth As Long
        ThisMonth = Month(Date)
        
    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 myDate = Date Then
        myFontColor = &HFFFF&
    End If
End Function

ユーザーフォームのクリックイベントについて、ボタンを滑らかに動かすために、色々と調整を行った。今のところ、こちらで落ち着いている。

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 = 10

    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.05"]
    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
End Sub

実は、動くところを様々な方法で録画しようとしているのだが、何故だか上手くいかない。仕方なく、録画用に「１クリック毎に動く」ように一時的に変更した結果がこちら。

正直、録画が上手くいかなくて、これにばかり時間を取られている。本当は、もっと滑らかに動いているのに。

ということで、動きをお伝えするのは一旦諦めて、カレンダーの作りこみに注力します。

参考まで。