자동 달력 생성기 (1년치 달력 추가)

 

연초라 달력을 자동으로 생성하는 프로그램을 만들어 보았습니다.

년도를 입력하면 VBA로 계산해서12달의 달력을 슬라이드로 출력하는 PPT프로그램입니다.

 

이렇게 별다른 디자인이 없는 기본 달력입니다.

가장 큰 특징은 년도만 입력하면 그 해의 12달 달력을 자동으로 출력한다는 점입니다.

그리고 단 한개의 Shape도 모두 VBA를 이용해서 출력합니다.

그래서 미리 배경이미지나 그림 등을 편집한 상태에서

VBA함수를 돌리면 그림 위에 달력이 뜨게 됩니다.

심지어는 모든 슬라이드를 지운 상태에서도 달력이 생성됩니다.

 

슬라이드 마스터나 배경서식, 디자인 등에서 화면 디자인을 정하고 시작할 수도 있습니다.

빈슬라이드가 되었든 사진12장이 포함된 슬라이드가 되었든

 첨부파일을 열고 Alt-F11을 눌러서 VBE 창을 띄우세요.

매크로는 당연히, 또 반드시 허용을 해주셔야 합니다.

 

함수 밖에 커서를 두시고 F5로 함수를 실행합니다.

MakeCalendar 는 현재 선택된 임의의 PPT슬라이드에 달력을 생성해주고

EraseCalendar는 생성된 달력을 모조리 삭제합니다.

 

EraseCalendar 를 실행하면

캡쳐화면처럼 정말로 지울건지 물어봅니다.

 

내부적으로 슬라이드내에 "Label_" 시작하는 개체를 모두 지우고

슬라이드 이름이 "Slide_Mon" 이면 슬라이드자체도 지웁니다.

다 지우고 나서는 캡쳐화면처럼 안내사항이 뜹니다.

MakeCalendar를 실행하면 다시 달력을 생성할 수 있다는 내용입니다.

 

이 화면은 모든 슬라이드가 지워진 상태입니다.

이상태에서도 달력이 생성됩니다.

 

이번에 MakeCalendar 를 실행한 화면입니다.

년도만 입력해주면 됩니다.

기본으로 올해 년도가 뜨므로 그냥 엔터만 눌러도 됩니다.

2018, 2016, 자신이 태어난 해 등등 아무 연도나 입력해도 됩니다.

 

 

실행전이나 실행 후에 [ 디자인-페이지설정-세로 ]로 하면 세로로 긴 달력 페이지가 됩니다.

TopMargin 을 크게 조정하고 상단에 그림을 삽입할 수도 있겠습니다.

물론 16:9로 가로로 넓은 달력도 편집하기 나름입니다.

 

 

이 화면은 생성된 달력을 편집해본 화면입니다.

나름대로의 배경과 글자체 변경, 디자인 변경이 가능하겠습니다.

 

세부적인 달력 출력 설정은 주석을 잘 활용해서 고치면 되겠습니다.

물론 VBA를 알아야 고칠 수 있겠지만요.

 

***** 아래는 VBA 소스 설명입니다. *****

 

소스를 보시면 초반에 이부분은 여백을 조절하는 부분입니다.

 

Const TopMargin = 30  ' 상단 여백

Const TitleHeight = 34  ' 달 이름의  높이

Const Margin = 30      ' 테두리 여백

 

 

아래 부분은 좌상단의 년도 출력부분입니다.

' add year and month name

        Set shp = sld.Shapes.AddTextbox(msoTextOrientationUpward, 0, 10, Margin, 100)

        shp.TextFrame.TextRange.Text = myYear

        shp.TextFrame.TextRange.Font.Color.RGB = rgbLightGrey

        shp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight

        shp.Name = "Year" & myYear

필요 없으면 전부 주석처리하면 됩니다. 

(VBE편집화면에서 [보기-도구모음-편집]으로 편집 아이콘 불러오면 주석처리 아이콘이 있음)

 

 

그다음 부분은 달이름 출력부분입니다.

 Set shp = sld.Shapes.AddShape(msoShapeRoundedRectangle, MW \ 2 - 100, Margin + TopMargin, 200, TitleHeight)

        'shp.Line.ForeColor.RGB = rgbWhite

        shp.Line.Visible = msoFalse

        'shp.Fill.ForeColor.RGB = rgbWhite

        shp.Fill.Visible = msoFalse

        shp.TextFrame.TextRange.Font.Color.RGB = rgbBlack   '글자색, RGB(255,0,0) 이런 식으로 색깔지정 가능

        shp.TextFrame.TextRange.Font.Size = 40   '글자크기

        shp.TextFrame.TextRange.Font.Bold = msoTrue   ' 진하게

        shp.TextFrame.TextRange.Font.Shadow = msoTrue '그림자 여부

        'myMonthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

        'shp.TextFrame.TextRange.Text = myMonthNames(m)

        'shp.TextFrame.TextRange.Text = m                       ' just the Arabic number of the month

        shp.TextFrame.TextRange.Text = MonthName(m, False)      ' 한글윈도우에서는 1월,2월 이렇게 나오네요.

        shp.Name = "Label_Mon" & m

여기를 조절하면 달 이름을 영어로 혹은 아라비아 숫자로 출력할 수 있습니다.

 

 

아래 부분은 요일 제목을 표시하는 부분입니다.

Set shp = sld.Shapes.AddShape(msoShapeRoundedRectangle, Margin + (i - 1) * w, Margin + TopMargin + TitleHeight, w, h)

            'shp.Line.ForeColor.RGB = rgbWhite

            shp.Line.Visible = msoFalse

            'shp.Fill.ForeColor.RGB = rgbWhite

            shp.Fill.Visible = msoFalse

            shp.TextFrame.TextRange.Text = WeekdayName(i, True)  ' 이것도 한글윈도우에서는 월화수목금 이렇게 나옵니다.

            'myWeekDays = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")

            'shp.TextFrame.TextRange.Text = myWeekDays(i) 

            shp.TextFrame.TextRange.Font.Size = 24

            shp.TextFrame.TextRange.Font.Bold = msoTrue

            shp.TextFrame2.TextRange.Font.Spacing = -2

           '일요일은 빨간색, 토요일은 파란색, 나머지는 검은 색 지정

            If i = 1 Then shp.TextFrame.TextRange.Font.Color.RGB = rgbRed _

            Else If i = 7 Then shp.TextFrame.TextRange.Font.Color.RGB = rgbBlue _

            Else shp.TextFrame.TextRange.Font.Color.RGB = rgbBlack

            shp.Name = "Label_Weekday" & i

이부분도 요일 이름을 영어로 할 수도 있고

글자 색이나 개체의 모양, 색깔, 테두리 여부를 고칠 수 있습니다.

 

마지막으로 날(하루)을 출력하는 부분입니다.

Set shp = sld.Shapes.AddShape(msoShapeRoundedRectangle, x, y, w, h)

            shp.Adjustments(1) = 0.1                     ' 0 = Rectangle, 1 = almost Circle

            shp.Line.ForeColor.RGB = rgbGrey

            shp.Line.Weight = 1

            'shp.Line.Visible = msoFalse

            'shp.Fill.ForeColor.RGB = rgbWhite

            shp.Fill.Visible = msoFalse

            If i Mod 7 = 1 Then shp.TextFrame.TextRange.Font.Color.RGB = rgbRed _

            Else If i Mod 7 = 0 Then shp.TextFrame.TextRange.Font.Color.RGB = rgbBlue _

            Else shp.TextFrame.TextRange.Font.Color.RGB = rgbBlack

            shp.TextFrame.TextRange.Font.Name = "Consolas"

            shp.TextFrame.TextRange.Font.Size = 28

            If d <= 0 Then                                  ' day of the previous month

                shp.TextFrame.TextRange.Text = CInt(Day(DateSerial(myYear, m - 1, 0))) + d

                shp.TextFrame.TextRange.Font.Color.RGB = rgbLightGrey

            ElseIf d > 0 And d <= LastDayofMonth Then       ' day of this month

                shp.TextFrame.TextRange.Text = d

            Else                                            ' day of next month

                shp.TextFrame.TextRange.Text = i - StartingWeekDay - LastDayofMonth

                shp.TextFrame.TextRange.Font.Color.RGB = rgbLightGrey

            End If

            'to put days on the top-left of the box

            'shp.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignLeft

            'shp.TextFrame2.VerticalAnchor = msoAnchorTop

            shp.Name = "Label_Day" & i & ":" & d

글자 크기, 색상, 좌우/상하정렬 등등을 조절할 수 있습니다.

 

달력 만들 때 그 달의 시작하는 1일의 요일을 알아내는게 가장 급선무입니다.

VBA에서는 WeekDay 함수를 씁니다.

StartingWeekDay = WeekDay("2017-1-1")  이렇게 하면 1(일)부터 7(토)까지의 값을 리턴합니다.

 

그 다음으로 그 달의 마지막날의 숫자를 알아야합니다.

2월 같은 경우 28일이기도 하고 29일이기도 하기 때문입니다.

VBA에서는 DateSerial(2017, 1,1)을 이용하면 특정날짜의 날짜값을 알 수 있는데 

특히 다음달의 0일째 날을 구하면 그것이 바로 이달의 마지막 날짜입니다

그래서 Day(DareSerial(myYear, m + 1, 0)) 이런 식으로 알아냅니다.

달력 만들 때 이 두 가지가 가장 핵심입니다.

 

첨부파일을 열어보시고 응용하시거나 연구해보시고 또 편집해보세요...

 

추가로 요일 이름을 영어로 하고

글자체를 얄쌍한;; "혜움네모고딕122"으로 바꿔보았습니다.

http://www.heumm.com/bbs/board.php?bo_table=download&wr_id=361&sca=%B8%ED%C1%B6%2F%B0%ED%B5%F1&page=4

http://withjavac.tistory.com/50

(참고로 공개된 혜움폰트는 개인적인 사용에 한하여 무료입니다.)

 

 

그리고 마지막 13번째 슬라이드에 1년치 전체 달력이 생성되도록 했습니다.

이것도 프로그램을 다시 돌리기 보다

1월부터 12월치를 그룹으로 묶은 다음 

아래처럼 13번 슬라이드에 복사/붙이기를 하고 

개체 크기와 글자크기만 줄여주었습니다.

 

    Set sld = ActivePresentation.Slides(13)     ' 12개의 달력이 모여질 13번째 슬라이드를 지정

    w = (MW - Margin * 2) \ 4                   ' 4*3 =12

    h = (MH - Margin * 2 - TitleHeight) \ 3     ' 각 달력의 가로,세로 크기

    With sld.Shapes.AddTextbox(msoTextOrientationHorizontal, MW \ 2 - 50, Margin, 100, TitleHeight)

        .TextFrame.TextRange.Text = myYear

        .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter  '가운데 정렬

        .Name = "Label_Year_" & myYear

    End With

    For m = 1 To 12

        With ActivePresentation.Slides(m)

            '해당달의 달력그룹을 복사

            .Shapes("Label_Group_" & m).Copy

            '13번째 슬라이드에 적절한 위치에 붙이기

            With sld.Shapes.Paste

                '.LockAspectRatio = msoTrue       ' 비율고정

                '.ScaleWidth 0.22, msoFalse       ' 1/4 로 축소

                .Width = w - 12                   ' 축소된 가로크기 지정

                .Height = h - 10                  ' 축소된 세로크기 지정

 

                '글자크기 줄이기

                For Each shp In .GroupItems

                    If shp.HasTextFrame Then

                        shp.TextFrame.TextRange.Font.Size = 8

                        shp.TextFrame2.TextRange.Font.Spacing = -0.6

                    End If

                    If shp.Line.Visible = msoTrue Then shp.Line.Visible = msoFalse '라인은 없애줌

                Next shp

                .Left = Margin + ((m - 1) Mod 4) * w                ' x 좌표

                .Top = TitleHeight + Margin + ((m - 1) \ 4) * h     ' Y 좌표

            End With

        End With

    Next m

글자를 좌측 상단에 정렬시킨 버전입니다.

MakeCalEngLeftTop.pptm 이 현재로서는 최근 버전입니다.

 

http://cafe.naver.com/gameppt/124341

 

MakeCalendar.pptm

다운로드

MakeCalendarEng.pptm

다운로드

마지막 슬라이드에 12달 달력을 복사해서 모을 때 개체 오류가 나는 것을 수정한 버전:

MakeCalendarEngLeftTop.pptm

0.15MB