엑셀 VBA로 양력 달력만들기(소스 공유)

엑셀 VBA로 양력 달력만들기

  안녕하세요.

  엑셀 VBA 로 기본적인 양력 달력을 만드는법을 공유해드리겠습니다.

 

 

기본달력2.xlsm

0.03MB

 

첨부한 파일은 이 달력입니다. 

(엑셀옵션에서 개발자도구 활성화시키고 Alt + F11 누르면 VBA 코드창이 뜹니다.)

 

보시면 A 라인에 달력의 숫자에 해당하는 주소값이 나열되있습니다.

그 주소를 참조해서 공휴일에 해당하는 숫자색상을 바꾸던지

숫자옆에 넣던지 아래에 넣던지 할수가 있도록 만들었습니다.

 

 간단한 달력이지만 기본만 해도 생각보다 고려할 요소들이 있어서 소스가 꽤 길어졌습니다. 

이 소스를 응용해서 더 멋진 달력을 만드실 수 있으실겁니다.

 

Option Explicit
 
Dim LocNum              As Range  ' 달력에서 숫자가 위치한 주소값 저장할 개체변수 선언
 
' ---------------------------------------------
 
Sub Main()
 
  Dim Year  As Integer
 
  Dim Month As Integer
 
  Dim X     As Integer
 
  Dim rng   As Range
 
  Dim rngCalendar         As String  '달력 Max 범위 주소
 
  
 
 With Sheets("Sheet1")
 
  Set rng = .Range("B5")             ' 달력이 그려질 위치 좌측상단 포인트 지정( 일요일 위치)
 
  Set LocNum = .Range("A1:A32")      ' 달력 숫자 주소값 저장할 영역할당
 
 End With
 
 
 
   Year = Cells(2, 2).Value  ' 연 값
 
   Month = Cells(2, 3).Value ' 월 값
 
   X = 3                      ' 달력 숫자사이의 간격
 
   
 
   rngCalendar = rng.Offset(1, 0).Address & ":" & rng.Offset(6 * X, 6).Address  ' 달력Max 범위주소
 
   
 
   Call Calendar_Init(rngCalendar)             ' 이전달력초기화
 
   Call Calendar_Base(Year, Month, X, rng)   ' 기본 달력표기
 
   Call Calendar_Sunday_Red(rng, X)          ' 일요일 빨간색
 
   Call Calendar_HappyDay_Red(Month)       ' 공휴일 표기 ( 음력으로 쉬는 추석,설날 제외)
 
 
 
 '- 메모리 초기화-
 
 Set rng = Nothing                        
 
 Set LocNum = Nothing   
 
 
 
End Sub
 
 
' ---------------------------------------------
 
Private Sub Calendar_Init(rngCalendar As String)
 
    Dim i As Integer
 
    Dim Count As Integer
 
On Error Resume Next                           ' 에러발생시 건너뜀
 
    Range(rngCalendar).ClearContents           ' 달력전체 내용삭제 (서식은 제외)
 
   Count = Range("A1").End(xlDown).Row
 
 For i = 1 To Count: Range(LocNum(i).Value).Font.Color = RGB(0, 0, 0): Next i   '==숫자는 전부 검은색으로== 
 
End Sub
 
' ---------------------------------------------
 
Private Sub Calendar_Base(Year As Integer, Month As Integer, X As Integer, rng As Range)
 
 
   Dim FirstDay As String        '첫날짜 - 문자열 형식으로
 
   Dim lastday As Integer        '마지막 날짜 숫자
 
   Dim Row As Integer            'Row
 
   Dim Column As Integer         'Column
 
   Dim NDate As Integer
 
 
'<---- 에러체크 -- >
 
 If Year < 1900 Or Year > 9000 Then     ' 엑셀 Edate 함수가 1900밑으로는 오류난다. 엑셀에서 날짜의 시작은 1900/01/01 .
 
      MsgBox "경고! 올바른 년도를 입력하세요"
 
     Exit Sub
 
    End If
 
     
 
 If Month > 12 Or Month < 1 Then
 
      MsgBox "경고! 올바른 월을 입력하세요"
 
       Exit Sub
 
    End If
 
    
 
'<----날짜 계산 ---->
 
With Application.WorksheetFunction                   '엑셀 함수 사용
 
        FirstDay = Year & "-" & Month & "-01"
 
        lastday = .EDate(FirstDay, 1) - .EDate(FirstDay, 0) '
 
        Column = .Weekday(FirstDay)                ' Ex) 토요일은 7이라는 값이 나옴
 
End With
 
        For NDate = 1 To lastday
 
        rng.Offset(Row + 1, Column - 1).value = NDate
 
        LocNum(NDate).Value = rng.Offset(Row + 1, Column - 1).Address ' 날짜 위치 주소값 저장 .
 
               ' Ex) LocNum(14).value -> 날짜 14가 위치한 주소값
 
        Column = (Column Mod 7) + 1      
 
        If Column = 1 Then
 
        Row = Row + X: End If
 
       Next      
 
End Sub
 
 
' ---------------------------------------------
 
Private Sub Calendar_Sunday_Red(rng As Range, X As Integer)
 
    Dim i As Integer
 
    For i = 0 To 5: rng.Offset((i * X) + 1, 0).Font.Color = RGB(255, 0, 0): Next i ' 1~4+rg칸
 
  End Sub
 
' ---------------------------------------------
 
Private Sub LTo(Loc As String, Text As String)
 
    Range(Loc).Value = Range(Loc).Value & Text      ' ; 숫자옆에 Text 표시
 
 '   Range(Loc).Offset(1, 0).Value = Text             : 숫자한칸아래 Text 표시  
 
End Sub
 
' ---------------------------------------------
 
Private Sub Calendar_HappyDay_Red(Month As Integer)  
 
' 공휴일숫자옆에 표시 + 숫자 빨강 ( 음력으로 쉬는 설날과 추석은 제외)
 
    Select Case Month
 
        Case 1: Range(LocNum(1)).Font.Color = RGB(255, 0, 0): Call LTo(LocNum(1).Value, " 신정")
 
        Case 3: Range(LocNum(1)).Font.Color = RGB(255, 0, 0): Call LTo(LocNum(1).Value, " 3.1절")
 
        Case 5: Range(LocNum(5)).Font.Color = RGB(255, 0, 0): Call LTo(LocNum(5).Value, " 어린이날")
 
        Case 6: Range(LocNum(6)).Font.Color = RGB(255, 0, 0): Call LTo(LocNum(6).Value, " 현충일")
 
        Case 7: Range(LocNum(17)).Font.Color = RGB(255, 0, 0): Call LTo(LocNum(17).Value, " 제헌절")
 
        Case 8: Range(LocNum(15)).Font.Color = RGB(255, 0, 0): Call LTo(LocNum(15).Value, " 광복절")
 
        Case 10: Range(LocNum(9)).Font.Color = RGB(255, 0, 0): Call LTo(LocNum(9).Value, " 한글날")
 
        Case 12: Range(LocNum(25)).Font.Color = RGB(255, 0, 0): Call LTo(LocNum(25).Value, " 성탄절")
 
     End Select
 
 End Sub
 
 
 

 

달력은 사랑입니다.