テスト25

'標準モジュール
Sub calender()

UserForm6.Show vbModeless

End Sub

'-----------------------------------
'ユーザーフォーム
'事前に日にちラベル42個、曜日ラベル7個、その他必要なコントロールを配置
Public disp_day As Date

'クラス型配列変数
Private myDayLabel(0 To 42) As New Cls_Calender
Private UF As New Cls_Calender

Private Sub UserForm_Initialize()

    Dim cnt As Integer

    With UserForm6.Controls("MonthLabel")

        .BorderStyle = fmBorderStyleSingle
        .TextAlign = fmTextAlignCenter
        .FontSize = 14

    End With

    For cnt = 0 To 41

        With UserForm6.Controls("Day_" & cnt + 1)

            .TextAlign = fmTextAlignCenter
            .FontSize = 12
            .BackStyle = fmBackStyleOpaque
            .BackColor = RGB(255, 153, 204)

        End With

        'クリック時のイベントをクラス型配列変数に登録
        myDayLabel(cnt).myLabelClass UserForm6.Controls("Day_" & cnt + 1)

    Next

    UF.UForm UserForm6

    Call ThisMonth_Click

End Sub

Private Sub ThisMonth_Click()

    Dim t_year As Integer
    Dim t_month As Integer

    t_year = Year(Now)

    t_month = Month(Now)

    Call SetMonthDate(t_year, t_month)

End Sub

Public 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   '日付カウンタ


    MonthLabel.Caption = disp_year & "年" & disp_month & "月"

    disp_day = disp_year & "/" & disp_month & "/1"

    t_week = Weekday(disp_year & "/" & disp_month & "/" & 1)

    For cnt = 1 To t_week - 1
        With UserForm6.Controls("Day_" & cnt)
            .Caption = ""
        End With
    Next


    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 UserForm6.Controls("Day_" & cnt)

            .Caption = set_day

        End With

        If Year(Now) = disp_year Then

            If Month(Now) = disp_month Then

                If Day(Now) = set_day Then


                    With UserForm6.Controls("Day_" & cnt)

                        .TextAlign = fmTextAlignCenter
                        .FontSize = 12
                        .BackStyle = fmBackStyleOpaque
                        .BackColor = RGB(255, 153, 204)

                    End With

                End If

            End If

        End If

        set_day = set_day + 1

    Next

    For cnt = t_end + 1 To 42

        With UserForm6.Controls("Day_" & cnt)
            .Caption = ""
        End With

    Next

End Function

Private Function Init_label()

    Dim cnt As Integer

    For cnt = 1 To 42

        With UserForm6.Controls("Day_" & cnt)

            .TextAlign = fmTextAlignCenter
            .FontSize = 12
            .BackStyle = fmBackStyleOpaque
            .BackColor = RGB(255, 153, 204)

        End With

    Next

End Function

Private Sub Next_M_Click()

    Dim t_year As Integer
    Dim t_month As Integer
    Dim next_month As Date

    Call Init_label

    t_year = Year(disp_day)
    t_month = Month(disp_day)

    next_month = DateSerial(t_year, t_month + 1, 1)

    t_year = Year(next_month)
    t_month = Month(next_month)

    Call SetMonthDate(t_year, t_month)

End Sub

Private Sub Pre_M_Click()

    Dim t_year As Integer
    Dim t_month As Integer
    Dim pre_month As Date

    Call Init_label

    t_year = Year(disp_day)
    t_month = Month(disp_day)

    pre_month = DateSerial(t_year, t_month - 1, 1)

    t_year = Year(pre_month)
    t_month = Month(pre_month)

    Call SetMonthDate(t_year, t_month)

End Sub

'---------------------------------
'クラスモジュール(Cls_Calender)

Public WithEvents DayLabels As MSForms.Label
Public WithEvents UFevent As MSForms.UserForm
Public ucnt As Variant

Public Sub myLabelClass(setlabel As MSForms.Label)

    Set DayLabels = setlabel

End Sub

Public Sub UForm(setlabel As MSForms.UserForm)

    Set UFevent = setlabel

End Sub


Private Sub DayLabels_Click()

    Dim select_year As Integer
    Dim select_month As Integer

    select_year = Year(UserForm6.disp_day)
    select_month = Month(UserForm6.disp_day)


    If Not DayLabels.Caption = "" Then

        ActiveCell.value = select_year & "/" & select_month & "/" & DayLabels.Caption

    End If

End Sub


Public Sub DayLabels_Mousemove(ByVal Button As Integer, _
                             ByVal Shift As Integer, ByVal X As Single, _
                             ByVal Y As Single)

    DayLabels.SpecialEffect = 1
    ThisWorkbook.Sheets("設定").Range("M1").value = Replace(DayLabels.Name, "Day_", "")

End Sub

Public Sub UFevent_Mousemove(ByVal Button As Integer, _
                             ByVal Shift As Integer, ByVal X As Single, _
                             ByVal Y As Single)
Dim ucnt As Variant

ucnt = ThisWorkbook.Sheets("設定").Range("M1").value

If ucnt <> "" Then

    UserForm6.Controls("Day_" & ucnt).SpecialEffect = 0

End If

End Sub