DatePicker 만들기 - 3 (레이블 이벤트를 이용한 날짜 선택)

□ 레이블이벤트를 사용할 클래스 추가 및 동작 지정

• 삽입 - 클래스 모듈 (이름 : cLblEvents )
• WithEvents를 사용하여클래스 내부에 이베트를 가진 레이블을 추가 (이름: lbl )
• 동작 : 레이블을 클릭하거나 더블클릭하면 Tag에 있는 날짜를 SelectedDate 인터페이스를 통해 지정
• 선택된 날짜를 기재하고 폼은 숨기기

Public WithEvents lbl As MSForms.Label

Private Sub lbl_Click()
    If Left(lbl.Name, 3) = "lbD" Then
        lbl.Parent.SelectedDate = CDate(lbl.Tag)
        lbl.Parent.Hide
    End If
End Sub

Private Sub lbl_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If Left(lbl.Name, 3) = "lbD" Then
        lbl.Parent.SelectedDate = CDate(lbl.Tag)
        lbl.Parent.Hide
    End If
End Sub

 

 

□  Calendar 폼에서 클래스를 사용하도록 지정

• 이베트 클래스를 모아서 작업할 Collection을 폼의 코드 첫부분에 추가

Dim colLabels As New Collection     '' 레이블이벤트 클래스를 사용할 콜렉션을 추가

 

□  폼이 시작할 때 콜렉션에 추가

• 레이블 이름을 기준으로 날짜용 레이블인지 확인 ( lbDxx )
• 날짜용 레이블을 포함할 클래스를 생성
• 레이블을 클래스에 추가하고 레이블을 가진 클래스를 Collection에 추가함 (총 42개)
• 이렇게 하면 이제 lbDxx 레이블들은 모두 똑같은 Click, DblClick 이벤트를 가지게 됨

Private Sub UserForm_Initialize()
    Dim i As Long
    Dim obEvents As cLblEvents      '' 레이블이벤트용 클래스

    For i = 1 To 42                 '' 날짜레이블들 42개를 클래스에 지정
        If TypeOf Controls("lbD" & i) Is MSForms.Label Then
           Set obEvents = New cLblEvents
           Set obEvents.lbl = Controls("lbD" & CStr(i))
           colLabels.Add obEvents   '' 클래스를 Collection에 추가
        End If
    Next i

    Redraw
End Sub

 

□  명령단추에 기능 추가

• OK : 현재 날짜를 그대로 두고 종료
• Today : 달력을 오늘이 있는 달로 변경
• Delete : 선택된 날짜를 -1로 지정하여 나중에 값을 지우도록 표시

Private Sub btnOK_Click()
    ActiveCell = Me.SelectedDate
    Me.Hide
End Sub

Private Sub btnToday_Click()
    Me.SelectedDate = Date
    Redraw
End Sub

Private Sub btnDelete_Click()
    Me.SelectedDate = -1
    Me.Hide
End Sub

 

□  셀에서 날짜 선택 

• 삽입 - 모듈
• 일반 모듈에 아래 코드 추가
• Sheet에 버튼을 만들고 아래 매크로를 연결
• 날짜를 입력할 셀을선택하고 버튼 클릭!!

Sub ShowDatePicker()
    Dim Target As Range
    Set Target = ActiveCell
    
    With formCalendar
        .SelectedDate = IIf(IsDate(Target.Cells(1, 1).Value), Target.Cells(1, 1).Value, Date)
        .Redraw
        .Show   ''여기에서 사용자가 날짜 선택
        '' form에서 [X]를 누르면 Unload되어 개체가 사라져서 아래 오류가 나는 것을 방지함
        If Not IsFormLoaded("formCalendar") Then Exit Sub

        If .SelectedDate = -1 Then        ''삭제 표시된 것
            Target.Cells(1, 1) = Empty
        Else
            Target.Cells(1, 1) = .SelectedDate
        End If
    End With
    Unload formCalendar
End Sub

Public Function IsFormLoaded(formName As String) As Boolean
    Dim frm As Object
    For Each frm In VBA.UserForms
        If frm.Name = formName Then
            IsFormLoaded = True
            Exit Function
        End If
    Next frm
    IsFormLoaded = False
End Function

 

DatePicker.xlsm

0.04MB