Excel - VBA

DatePicker 만들기 - 2 (레이블을 이용한 Calendar 날짜 정리)

EGTools 2023. 5. 5. 13:20
728x90

□  DatePicker에서 사용할 내부 변수 및 인터페이스 설정

  • 내부에서 사용할 변수로 date_Selected를 선언
  • 이 변수를 설정하고 읽어올 인터페이스를 정의 (Let, Get)
Private date_Selected As Date

Public Property Let SelectedDate(argDate As Date)
    date_Selected = argDate
End Property

Public Property Get SelectedDate() As Date
    SelectedDate = date_Selected
End Property

 

□  달력을 만드는 프로시저 생성

  • 인수 : 연도(필수), 월(필수), 일(선택)
  • 레이블의 이름을 기준으로 레이블 컨트롤을 지정하여 날짜 및 서식을 적용 (lbD1~42, lbW1~6)
  • 레이블의 Tag에 YYYY-MM-DD 형식으로 실제 날짜를 기재
  • 레이블의 Caption에는 날짜만 기재
  • 당월의 날짜가 아닌 전원/익월의 날짜는 흐리게
  • 지정한 날자에 대해서 바탕색을 다르게 지정
Public Sub MakeCalendar(argYear As Integer, argMonth As Integer, Optional argDate As Integer)
    Dim i As Integer
    Dim Weekday_prevMonth_Last As Integer
    Dim Weekday_thisMonth_Last As Integer
    Dim date_prevMonth_Last As Integer
    Dim date_thisMonth_Last As Integer
    Dim int_Date As Integer
    Dim date_thisMonth As Date
    Dim date_thisDay As Date
    
    '' 당월1일 및 전월말일/요일, 당월말일/요일
    date_thisMonth = DateSerial(argYear, argMonth, 1)
    int_Date = Format(Date, "d")
    Weekday_prevMonth_Last = Weekday(DateSerial(Year(date_thisMonth), Month(date_thisMonth), 1), vbSunday) - 1
    Weekday_thisMonth_Last = Weekday(DateSerial(Year(date_thisMonth), Month(date_thisMonth) + 1, 0), vbSunday)
    date_thisMonth_Last = Format(DateSerial(Year(date_thisMonth), Month(date_thisMonth) + 1, 0), "d")
    date_prevMonth_Last = Format(DateSerial(Year(date_thisMonth), Month(date_thisMonth), 0), "d")
        
    Me.lbYEAR.Tag = Year(date_thisMonth)
    Me.lbYEAR.Caption = Year(date_thisMonth) & "년"
    Me.lbMONTH.Tag = Month(date_thisMonth)
    Me.lbMONTH.Caption = Month(date_thisMonth) & "월"
    
    '' 앞달의 끝날부터 해당 요일에 맞는 ID에 써넣기
    '' 앞달 끝날이 31일로 월요일이면 2번 ID에, 30일은 일요일로 1번 ID에 배정됨
    For i = Weekday_prevMonth_Last To 1 Step -1
        date_thisDay = DateSerial(Year(date_thisMonth), Month(date_thisMonth) - 1, date_prevMonth_Last - (Weekday_prevMonth_Last - i))
        Controls("lbD" & CStr(i)).Font.Size = 9
        Controls("lbD" & CStr(i)).Font.Bold = False
        Controls("lbD" & CStr(i)).Caption = DatePart("d", date_thisDay)
        Controls("lbD" & CStr(i)).Tag = Format(date_thisDay, "yyyy-mm-dd")
        Controls("lbD" & CStr(i)).ForeColor = RGB(150, 150, 150)   ' 회색
        Controls("lbD" & CStr(i)).BackColor = RGB(255, 255, 255)   ' 흰색
        Controls("lbD" & CStr(i)).BorderStyle = fmBorderStyleNone
    Next i
    
    '' 당월은 1일의 요일에 맞는 ID부터 차례로 써 넣는다
    For i = 1 To date_thisMonth_Last
        date_thisDay = DateSerial(Year(date_thisMonth), Month(date_thisMonth), i)
        Controls("lbD" & CStr(i + Weekday_prevMonth_Last)).Font.Size = 9
        Controls("lbD" & CStr(i + Weekday_prevMonth_Last)).Font.Bold = True
        Controls("lbD" & CStr(i + Weekday_prevMonth_Last)).Caption = i
        Controls("lbD" & CStr(i + Weekday_prevMonth_Last)).Tag = Format(date_thisDay, "yyyy-mm-dd")
        If Weekday(date_thisDay, vbSunday) = 1 Then
            Controls("lbD" & CStr(i + Weekday_prevMonth_Last)).ForeColor = RGB(255, 0, 0)
        ElseIf Weekday(date_thisDay, vbSunday) = 7 Then
            Controls("lbD" & CStr(i + Weekday_prevMonth_Last)).ForeColor = RGB(51, 102, 255)
        Else
            Controls("lbD" & CStr(i + Weekday_prevMonth_Last)).ForeColor = RGB(0, 0, 0)
        End If
        Controls("lbD" & CStr(i + Weekday_prevMonth_Last)).BorderStyle = fmBorderStyleSingle
    Next i

    '' 익월은 42(총달력날수)에서 (전월말일 주차수 + 당월말일 )
    For i = 1 To (42 - (Weekday_prevMonth_Last + date_thisMonth_Last))
        date_thisDay = DateSerial(Year(date_thisMonth), Month(date_thisMonth) + 1, i)
        Controls("lbD" & CStr(Weekday_prevMonth_Last + date_thisMonth_Last + i)).Font.Size = 9
        Controls("lbD" & CStr(Weekday_prevMonth_Last + date_thisMonth_Last + i)).Font.Bold = False
        Controls("lbD" & CStr(Weekday_prevMonth_Last + date_thisMonth_Last + i)).Caption = i
        Controls("lbD" & CStr(Weekday_prevMonth_Last + date_thisMonth_Last + i)).Tag = Format(date_thisDay, "yyyy-mm-dd")
        Controls("lbD" & CStr(Weekday_prevMonth_Last + date_thisMonth_Last + i)).ForeColor = RGB(150, 150, 150)
        Controls("lbD" & CStr(Weekday_prevMonth_Last + date_thisMonth_Last + i)).BackColor = RGB(255, 255, 255)
        Controls("lbD" & CStr(Weekday_prevMonth_Last + date_thisMonth_Last + i)).BorderStyle = fmBorderStyleNone
    Next i
    
    '' 캘린더를 불러올 때, 특정 날짜를 지정했으면 지정한 날을 표시한다
    If Not IsMissing(argDate) Then
        Controls("lbD" & CStr(argDate + Weekday_prevMonth_Last)).ForeColor = RGB(0, 0, 0)
        Controls("lbD" & CStr(argDate + Weekday_prevMonth_Last)).BackColor = RGB(180, 0, 0)
    End If
    
    '' 주차표시를 추가한다
    For i = 1 To 6
        Controls("lbW" & i).ForeColor = RGB(125, 125, 125)
        If i > 0 Then
            Controls("lbW" & i).Caption = Format(CDate(Controls("lbD" & (i - 1) * 7 + 1).Tag), """w""ww", vbSunday)
        End If
    Next i

End Sub

 

□  지정된 날짜를 기준으로 달력 그리기

  • 지정된 날짜가 있으면 그 날짜를 기준으로 
  • 없으면 오늘을 기준으로 
Public Sub Redraw()
    '' 지정된 날짜가 있으면 그 날짜를 기준으로 없으면 오늘을 기준으로 정리
    If Not IsDate(date_Selected) Or date_Selected < CDate("2000-01-01") Then date_Selected = Date
    Call MakeCalendar(Year(date_Selected), Month(date_Selected), Day(date_Selected))
End Sub

 

□  월변경 기능 추가

  • 전달과 다음달로 달력을 변경하도록  DateAdd함수를 사용
Private Sub lbLEFT_click()
    Dim newDate As Date
    newDate = DateAdd("m", -1, DateSerial(Me.lbYEAR.Tag, Me.lbMONTH.Tag, Day(Me.SelectedDate)))
    Me.SelectedDate = newDate
    Call MakeCalendar(Year(newDate), Month(newDate), Day(newDate))
End Sub

Private Sub lbRIGHT_click()
    Dim newDate As Date
    newDate = DateAdd("m", 1, DateSerial(Me.lbYEAR.Tag, Me.lbMONTH.Tag, Day(Me.SelectedDate)))
    Me.SelectedDate = newDate
    Call MakeCalendar(Year(newDate), Month(newDate), Day(newDate))
End Sub

 

□  폼 작동 시험

  • UserForm의 Initialize 이벤트에서 Redraw() 호출
  • 이제 [F5]를 누르면 이번달 달력이 나오게 됩니다.
Private Sub UserForm_Initialize()
    Redraw
End Sub

 

이번달 달력으로 실행된 상태
DatePicker-2.xlsm
0.03MB

728x90