テスト25

```vb

'標準モジュール
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
```