반응형
엑셀vba의 사용자 정의 폼을 이용해서 달력을 만들어보았다.
약간의 노가다가 필요하였다.
1. 폼 구성
커맨드버튼 2개와 레이블 48개, 프레임 1개를 이용해서 폼을 구성하였다.
- 레이블 사용처
1) 년도 표시 2개: 숫자, 년
2) 월 표시 2개: 숫자, 월
3) 달력 요일 7개: sun, mon, tue,wen...
4) 달력 일 35개: 1일 부터 마지막 일
5) 선택 날짜 표시 2개
2. 코드
달력코드는 모듈 3개와 폼 1개로 이뤄져있다.
-모듈 사용처
1) 달력에 날짜 표시 (1,2,3,4,....,31)
2) 글자의 볼드 해제
3) 달력 날짜 표시 삭제
-폼에 사용된 코드
1) 왼쪽 화살표 버튼: 이전 달로 이동
2) 오른쪽 화살표 버튼: 다음 달로 이동
3) 폼 열렸을 때 초기화
4) 날짜 선택 시 굵게 표시
2.1 날짜 표시 코드 (Module 1)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | Sub Calendar_Function(ByVal Month_Num As Integer, ByVal Year_Num As Integer) Dim ThirtyOne As String Dim Thirty As String Dim Now_Mon As String Dim Days As Integer Dim i As Integer Dim x As Integer Dim cnt As Integer Dim Result As Integer '---------------------------------------------- '변수 초기화 구역 ThirtyOne = "/1/3/5/7/8/10/12/" Thirty = "/4/6/9/11/" cnt = 1 Now_Mon = "/" & Month_Num & "/" UserForm3.Label_Car_Month.Caption = Month_Num '---------------------------------------------- '전달받은 값이 몇일 까지 있는지 확인 If InStr(1, ThirtyOne, Now_Mon) Then '31일까지 있으면 Days에 31 저장 Days = 31 ElseIf InStr(1, Thirty, Now_Mon) Then '30일까지 있으면 Days에 31 저장 Days = 30 Else '2월달은 윤년일 경우 29일, 아닌경우 28일로 저장 If (Year_Num Mod 4) = 0 Then Days = 29 If (Year_Num Mod 100) = 0 Then Days = 28 If (Year_Num Mod 400) = 0 Then Days = 29 End If End If Else Days = 28 End If End If '--------------------------------------------- '달력 일자 표시하는 구간 '레이블 35개 이용 '레이블 7개씩 5줄로 구성 (일,월,화,수,목,금,토) For x = 1 To 5 '첫쨰주부터 다섯째주까지 For i = 1 To 7 '일요일부터 토요일까지 Result = Format(Year_Num & "-" & Month_Num & "-" & cnt, "w") 'format(날짜값,"w"): 날짜값이 무슨 요일인지 숫자로 알려줌 '1 = 일요일, 2=월요일,...,7 = 토요일 If x = 1 Then Select Case Result Case 1 UserForm3.Week1_1.Caption = cnt Case 2 UserForm3.Week1_2.Caption = cnt Case 3 UserForm3.Week1_3.Caption = cnt Case 4 UserForm3.Week1_4.Caption = cnt Case 5 UserForm3.Week1_5.Caption = cnt Case 6 UserForm3.Week1_6.Caption = cnt Case 7 UserForm3.Week1_7.Caption = cnt End Select ElseIf x = 2 Then Select Case Result Case 1 UserForm3.Week2_1.Caption = cnt Case 2 UserForm3.Week2_2.Caption = cnt Case 3 UserForm3.Week2_3.Caption = cnt Case 4 UserForm3.Week2_4.Caption = cnt Case 5 UserForm3.Week2_5.Caption = cnt Case 6 UserForm3.Week2_6.Caption = cnt Case 7 UserForm3.Week2_7.Caption = cnt End Select ElseIf x = 3 Then Select Case Result Case 1 UserForm3.Week3_1.Caption = cnt Case 2 UserForm3.Week3_2.Caption = cnt Case 3 UserForm3.Week3_3.Caption = cnt Case 4 UserForm3.Week3_4.Caption = cnt Case 5 UserForm3.Week3_5.Caption = cnt Case 6 UserForm3.Week3_6.Caption = cnt Case 7 UserForm3.Week3_7.Caption = cnt End Select ElseIf x = 4 Then Select Case Result Case 1 UserForm3.Week4_1.Caption = cnt Case 2 UserForm3.Week4_2.Caption = cnt Case 3 UserForm3.Week4_3.Caption = cnt Case 4 UserForm3.Week4_4.Caption = cnt Case 5 UserForm3.Week4_5.Caption = cnt Case 6 UserForm3.Week4_6.Caption = cnt Case 7 UserForm3.Week4_7.Caption = cnt End Select ElseIf x = 5 Then Select Case Result Case 1 UserForm3.Week5_1.Caption = cnt Case 2 UserForm3.Week5_2.Caption = cnt Case 3 UserForm3.Week5_3.Caption = cnt Case 4 UserForm3.Week5_4.Caption = cnt Case 5 UserForm3.Week5_5.Caption = cnt Case 6 UserForm3.Week5_6.Caption = cnt Case 7 UserForm3.Week5_7.Caption = cnt End Select End If cnt = cnt + 1 If Result = 7 Then: Exit For '토요일이되면 요일 반복문에서 빠져나가도록 설정 If cnt > Days Then: GoTo FINISH Next Next x FINISH: End Sub | cs |
2.2 달력 월 변경되면 굵은 글씨 해제(Module 2)
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
Sub Calendar_Bold_False()
UserForm3.Week1_1.Font.Bold = False
UserForm3.Week1_2.Font.Bold = False
UserForm3.Week1_3.Font.Bold = False
UserForm3.Week1_4.Font.Bold = False
UserForm3.Week1_5.Font.Bold = False
UserForm3.Week1_6.Font.Bold = False
UserForm3.Week1_7.Font.Bold = False
UserForm3.Week2_1.Font.Bold = False
UserForm3.Week2_2.Font.Bold = False
UserForm3.Week2_3.Font.Bold = False
UserForm3.Week2_4.Font.Bold = False
UserForm3.Week2_5.Font.Bold = False
UserForm3.Week2_6.Font.Bold = False
UserForm3.Week2_7.Font.Bold = False
UserForm3.Week3_1.Font.Bold = False
UserForm3.Week3_2.Font.Bold = False
UserForm3.Week3_3.Font.Bold = False
UserForm3.Week3_4.Font.Bold = False
UserForm3.Week3_5.Font.Bold = False
UserForm3.Week3_6.Font.Bold = False
UserForm3.Week3_7.Font.Bold = False
UserForm3.Week4_1.Font.Bold = False
UserForm3.Week4_2.Font.Bold = False
UserForm3.Week4_3.Font.Bold = False
UserForm3.Week4_4.Font.Bold = False
UserForm3.Week4_5.Font.Bold = False
UserForm3.Week4_6.Font.Bold = False
UserForm3.Week4_7.Font.Bold = False
UserForm3.Week5_1.Font.Bold = False
UserForm3.Week5_2.Font.Bold = False
UserForm3.Week5_3.Font.Bold = False
UserForm3.Week5_4.Font.Bold = False
UserForm3.Week5_5.Font.Bold = False
UserForm3.Week5_6.Font.Bold = False
UserForm3.Week5_7.Font.Bold = False
End Sub
|
cs |
2.3 달력 월 변경되면 숫자표시 지우기(Module 3)
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
Option Explicit
Sub Remove()
UserForm3.Week1_1.Caption = ""
UserForm3.Week1_2.Caption = ""
UserForm3.Week1_3.Caption = ""
UserForm3.Week1_4.Caption = ""
UserForm3.Week1_5.Caption = ""
UserForm3.Week1_6.Caption = ""
UserForm3.Week1_7.Caption = ""
UserForm3.Week2_1.Caption = ""
UserForm3.Week2_2.Caption = ""
UserForm3.Week2_3.Caption = ""
UserForm3.Week2_4.Caption = ""
UserForm3.Week2_5.Caption = ""
UserForm3.Week2_6.Caption = ""
UserForm3.Week2_7.Caption = ""
UserForm3.Week3_1.Caption = ""
UserForm3.Week3_2.Caption = ""
UserForm3.Week3_3.Caption = ""
UserForm3.Week3_4.Caption = ""
UserForm3.Week3_5.Caption = ""
UserForm3.Week3_6.Caption = ""
UserForm3.Week3_7.Caption = ""
UserForm3.Week4_1.Caption = ""
UserForm3.Week4_2.Caption = ""
UserForm3.Week4_3.Caption = ""
UserForm3.Week4_4.Caption = ""
UserForm3.Week4_5.Caption = ""
UserForm3.Week4_6.Caption = ""
UserForm3.Week4_7.Caption = ""
UserForm3.Week5_1.Caption = ""
UserForm3.Week5_2.Caption = ""
UserForm3.Week5_3.Caption = ""
UserForm3.Week5_4.Caption = ""
UserForm3.Week5_5.Caption = ""
UserForm3.Week5_6.Caption = ""
UserForm3.Week5_7.Caption = ""
End Sub
|
cs |
2.2하고 2.3 은 하나로 만들어도 되는데 깔끔하게 보일려고 나눔 ㅎㅎ
2.4 이전 달로 이동 (commandbutton.click)
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
rivate Sub CommandButton1_Click()
Call Calendar_Bold_False
If Label_Car_Month.Caption > 1 Then
Calendar_Remove.Remove
Label_Car_Month.Caption = Label_Car_Month.Caption - 1
Call Calendar.Calendar_Function(Label_Car_Month.Caption, Label_CAR_YEAR.Caption)
Else
Label_CAR_YEAR.Caption = Label_CAR_YEAR.Caption - 1
Label_Car_Month.Caption = 12
Call Calendar.Calendar_Function(Label_Car_Month.Caption, Label_CAR_YEAR.Caption)
End If
End Sub
|
cs |
2.5 다음 달로 이동 (commandbutton.click)
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
Private Sub CommandButton2_Click()
Call Calendar_Bold_False
If Label_Car_Month.Caption < 12 Then
Calendar_Remove.Remove
Label_Car_Month.Caption = Label_Car_Month.Caption + 1
Call Calendar.Calendar_Function(Label_Car_Month.Caption, Label_CAR_YEAR.Caption)
Else
Label_CAR_YEAR.Caption = Label_CAR_YEAR.Caption + 1
Label_Car_Month.Caption = 1
Call Calendar.Calendar_Function(Label_Car_Month.Caption, Label_CAR_YEAR.Caption)
End If
End Sub
|
cs |
2.6 달력 열렸을 때 초기화(userform.initialize)
Private Sub UserForm_Initialize()
Label_CAR_YEAR.Caption = Year(Now)
Call Calendar.Calendar_Function(Month(Now), Year(Now))
End Sub2.7 날짜 클릭 했을 때 굵게 표시하기(Label.click)
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
|
Private Sub Week5_1_Click()
If Len(Week5_1.Caption) > 0 Then
If Week5_1.Font.Bold = False And Label11.Caption = "" Then
Week5_1.Font.Bold = True
Label11.Caption = Label_CAR_YEAR.Caption & "-" & Label_Car_Month.Caption & "-" & Week5_1.Caption
ElseIf Week5_1.Font.Bold = False And Len(Label11.Caption) > 0 Then
Week5_1.Font.Bold = True
Label12.Caption = Label_CAR_YEAR.Caption & "-" & Label_Car_Month.Caption & "-" & Week5_1.Caption
ElseIf Week5_1.Font.Bold = True And InStr(1, Label11.Caption, Week5_1.Caption) Then
Week5_1.Font.Bold = False
Label11.Caption = ""
ElseIf Week5_1.Font.Bold = True And InStr(1, Label12.Caption, Week5_1.Caption) Then
Week5_1.Font.Bold = False
Label12.Caption = ""
End If
End If
End Sub
|
cs |
날짜를 클릭하면 글자가 굵게되고 폼 하단에 표시가 되도록 했다.
첫째주 레이블은 Week1_1, Week1_2, Week1_3, ... , Week1_7
둘째주 레이블은 Week2_1, Week2_2, Week2_3, ... , Week2_7
이렇게 다섯째주까지 35개를 만들었다.
3. 달력
재밌는 달력 만들기였다.
반응형
'프로그램 > 완료' 카테고리의 다른 글
| [엑셀vba] 셀메이트 발송 확인 프로그램 (0) | 2021.02.03 |
|---|---|
| [엑셀vba] 재무제표 받아오기 (14) | 2021.01.12 |
| [엑셀양식] 계정 권한 변경 신청서 (0) | 2020.07.19 |
| [엑셀vba] EBS 방송국 편성표 가져와보기 (0) | 2020.05.30 |
| [엑셀vba] 쿠팡에 있는 상품을 스크래핑 해보자(feat. 자동로그인) (62) | 2020.05.20 |