이 글 역시 쓰게 된 계기가 지식인 질문에 대한 답변입니다.
강좌라기 보다는 파워포인트에서 메뉴-서브메뉴 시스템 구현을 한번 시도해보는 것이 목적입니다.
구현 목표/결과 화면은 아래와 같습니다.
왼쪽 상단의 메뉴 아이콘에 마우스를 올리면 메인 메뉴 목록이 뜨고
다시 메인 메뉴에 마우스를 가져가면 서브메뉴가 또 뜨고
서브메뉴를 클릭하면 해당 슬라이드로 이동하는 방식입니다.
애니메이션으로도 가능하겠지만 많은 슬라이드와 애니메이션이 필요하여
VBA로 만들어 보았습니다. 하지만 VBA로도 많은 부분에 신경을 써야만 했습니다.
시간여유가 없거나 VBA에 익숙하지 않은 분은 아래 캡쳐 영상만 보시고 첨부한 파일을 실행만 해보시기 바랍니다.
캡쳐영상에서는 메뉴 시스템의 구현 모습과 함께 사용자가 메뉴를 추가하는 방법을 보여줍니다.
아래는 VBA가 돌아가는 과정에 대한 안내입니다.
1. 일단 OnSlideShowPageChange 를 이용해서
슬라이드쇼가 시작되면 1슬라이드에서
모든 슬라이드에 메뉴아이콘을 좌측 상단에 추가합니다.(addShape)
그리고 메뉴 아이콘에 마우스오버 액션을 추가합니다.(ActionSettings(ppMouseOver))
슬라이드쇼 도중에 마우스가 아이콘 위에 올라오면 MouseOver라는 매크로가 실행됩니다.
Function StartMenu()
Dim pres As Presentation
Dim sld As Slide
Dim shp As Shape
Call initMenu
Set pres = ActivePresentation
For Each sld In pres.Slides
'create menu icon on top-left position
If Not existShape(sld, "menuM_Icon") Then
Set shp = sld.Shapes.AddShape(msoShapeRoundedRectangle, 0, 0, 30, 30)
With shp
With .ActionSettings(ppMouseOver)
.Action = ppActionRunMacro
.Run = "MouseOver"
End With
.Name = "menuM_Icon"
.TextFrame.TextRange.Text = "▤"
.TextFrame.TextRange.Font.Bold = msoTrue
.TextFrame.VerticalAnchor = msoAnchorBottom
.TextFrame.TextRange.Font.Color.RGB = rgbWhite
.Fill.ForeColor.RGB = rgbLightBlue
.Line.Visible = msoFalse
End With
End If
Next sld
End Function
2. 또한 메뉴와 서브메뉴는 수정이 가능하도록 배열로 초기화하도록 합니다.
Type myMenu
mainMenu As String
subMenu As Variant
subLink As Variant
End Type
Public Menu() As myMenu
Public MenuCount As Integer
Function initMenu()
MenuCount = 6 '// *** 반드시 최대 메뉴 개수 지정후 아래 메뉴 수정
ReDim Menu(MenuCount)
Menu(1).mainMenu = "Product Categories"
Menu(2).mainMenu = "menu1" '메인메뉴
Menu(2).subMenu = Array("sub1", "sub2", "sub3") '하위메뉴
Menu(2).subLink = Array(1, 2, 3) '하이퍼링크 슬라이드번호
Menu(3).mainMenu = "menu2"
Menu(3).subMenu = Array("sub1", "sub2", "sub3", "sub4", "sub5")
Menu(3).subLink = Array(4, 5, 6, 7, 8)
Menu(4).mainMenu = "menu3"
Menu(4).subMenu = Array("sub1", "sub2", "sub3", "sub4", "sub5", "sub6")
Menu(4).subLink = Array(9, 10, 11, 12, 13, 14)
Menu(5).mainMenu = "menu4"
Menu(5).subMenu = Array("sub1", "sub2", "sub3", "sub4")
Menu(5).subLink = Array(15, 16, 17, 18)
Menu(6).mainMenu = "menu5"
Menu(6).subMenu = Array("sub1", "sub2", "sub3", "sub4", "sub5")
Menu(6).subLink = Array(19, 20, 21, 22, 23)
End Function
Menu 배열은 구조체 형식으로 하부에 메뉴이름(mainMenu), 서브메뉴(subMenu), 하이퍼링크(subLink)로 구성되어 있습니다.
그리고 위 처럼 initMenu 코드에서 총 메뉴 개수인 MenuCount 를 (메뉴개수+1)를 조정해줍니다.
'메뉴1'~'메뉴5'까지면 6을 지정합니다. 1이 증가하는 이유는 'Product Categories' 라는 목록이 최상단에 하나 더 추가되기 때문입니다.
이 함수로 메뉴의 이름과 서브메뉴, 연결될 하이퍼링크페이지에 대한 정보가 정리되었습니다.
3. 다음은 주된 역할을 하는 MouseOver 함수입니다.
'메뉴 아이콘, 메인메뉴, 서브메뉴에 마우스가 올라올 때 호출되는 메인함수
Sub MouseOver(shp As Shape)
Dim pres As Presentation
Dim sld As Slide
Dim idx As Long
Set sld = shp.Parent
Set pres = sld.Parent
'idx = pres.SlideShowWindow.View.GetClickCount 'supported version: 2007 above
'Debug.Print idx
pres.SlideShowWindow.View.GotoClick msoClickStateAfterAllAnimations '애니메이션 마지막 위치로
pres.SlideShowWindow.View.State = ppSlideShowPaused '슬라이드쇼 애니메이션 중지
If shp.Name = "menuM_Icon" Then '메뉴 아이콘
showOutbox shp
showMenus shp
hideMenus shp, "sub"
ElseIf shp.Name Like "menu_*" Then '메인메뉴
highlightMenu shp
hideMenus shp, "sub"
showSubMenus shp
ElseIf shp.Name = "menuM_Outbox" Then '메뉴 바깥 영역
hideMenus shp
'pres.SlideShowWindow.View.GotoClick 0
pres.SlideShowWindow.View.State = ppSlideShowRunning '슬라이드쇼 애니메이션 계속
Else
'
End If
End Sub
이 메뉴 시스템의 기본 원리는 주로 마우스 오버 이벤트를 이용하는데요
메인메뉴에 마우스가 올라오면 다른 서브메뉴를 지우고 해당 서브메뉴들을 표시했다가
마우스가 나가면( 바깥 영역에 마우스가 올라가면) 메뉴를 지워주는 방식입니다.
MouseOver 함수의 구체적인 작동은
일단 메뉴에 마우스가 올라가면 슬라이드쇼를 잠깐 멈추고(view.state=ppSlideShowPaused)
(안그러면 메뉴 움직일 때마다 도형이 삭제, 나타나기 때문에 애니메이션이 처음부터 반복됨)
1) 메뉴 아이콘에 마우스가 있으면
마우스가 나갈 때 감지하기 위해서 메뉴화면 뒤로 화면 절반정도를 채우는 투명한 사각형을
아래 그림의 주황색 네모처럼 그려줍니다.(showOutbox)
이 네모 도형은 메뉴화면 바깥으로 마우스가 나올 때 이 사각형위로 마우스가 갈 때
마우스 위치를 감지하도록 하기 위함입니다. 이 때 메뉴 도형들을 삭제/감추기해줍니다.
그리고 나서 메인 메뉴들을 화면에 표시해줍니다.(showMenus)
2) 마우스가 메인메뉴 도형(Menu1~Menu5)에 올라왔을 때는
현재 메뉴를 반전시켜주고(highlightMenu)
기존 서브메뉴를 일단 지우고(HideMenus "sub") 다시 서브메뉴들을 표시해줍니다(showSubMenus)
3) 마지막으로 메뉴영역을 나가서 바깥 도형으로 가면
모든 메뉴 도형들을 지우고(hideMenus)
일시정지되었던 슬라이드쇼를 다시 시작합니다.
4. 그 밖에 메뉴를 화면에 보여주고 삭제하는 함수들이 있는데 모두 소개하기는 그렇고
서브메뉴를 표시하는 부분만 소개합니다.
Sub showSubMenus(shp As Shape)
Dim no As Integer
Dim oSld As Slide
Dim oShp As Shape
Dim i As Integer
Dim x As Single, y As Single, w As Single, h As Single
Set oSld = shp.Parent
no = CInt(Mid(shp.Name, 6))
For i = 1 To UBound(Menu(no).subMenu)
x = 20 + 150: y = no * 30 + (i - 1) * 30: w = 150: h = 30
Set oShp = oSld.Shapes.AddShape(msoShapeSnip1Rectangle, x, y, w, h)
With oShp
With .ActionSettings(ppMouseClick)
'.Action = ppActionHyperlink
'.Hyperlink.Address = shp.Parent.Parent.FullName
'.Hyperlink.SubAddress = Str(Menu(no).subLink(i))
'.Hyperlink.ScreenTip = Menu(no).subLink(i)
.Action = ppActionRunMacro
.Run = "gotoSubmenu"
End With
.Name = "menu_sub_" & CStr(no) & "_" & CStr(i)
.Fill.ForeColor.RGB = rgbLightGray
.Line.Weight = 1
.Line.ForeColor.RGB = rgbGray
.TextFrame.TextRange.Font.Size = 11
.TextFrame.TextRange.Font.Color.RGB = rgbBlack
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft
.TextFrame.TextRange.Text = Menu(no).subMenu(i)
End With
Next i
End Sub
서브메뉴 개수만큼(ubound(menu(no).subMenu))
한쪽이 접힌 사각형을 추가합니다.
그리고 마우스가 눌릴 때 gotoSubmenu 매크로에 실행 액션을 걸어줍니다. (.ActionSettings(ppMouseClick))
5. 다음은 서브메뉴에서 클릭시 해당 슬라이드로 이동하는 부분입니다.
Sub gotoSubmenu(shp As Shape)
Dim no1 As Integer, no2 As Integer, loc As Integer
Dim arr() As String
Dim ssw As SlideShowWindow
Set ssw = shp.Parent.Parent.SlideShowWindow
arr = Split(shp.Name, "_")
loc = InStrRev(shp.Name, "_")
no2 = Val(arr(UBound(arr)))
no1 = Val(arr(UBound(arr) - 1))
hideMenus shp
ssw.View.GotoSlide Menu(no1).subLink(no2), msoTrue
'ssw.View.GotoClick msoClickStateBeforeAutomaticAnimations
ssw.View.State = ppSlideShowRunning '슬라이드쇼 애니메이션 계속
End Sub
서브메뉴 도형을 누르면
도형의 이름이 menu_sub_주메뉴번호_서브메뉴번호 이기 때문에
이 이름을 Split으로 나줘서 뒤에 두 개의 숫자를 가져와서
Menu 구조체에 저장된 subLink 값을 찾아서 gotoSlide 에 인수로 넘겨줍니다.
6. 마지막으로 슬라이드쇼가 끝나면 모든 메뉴 관련 도형들을 모든 슬라이드에서 삭제해줍니다.
Sub deleteAllMenuStuff()
'모든 슬라이드의 메뉴관련 도형 삭제
Dim l As Long, m As Long
Dim pres As Presentation
Set pres = ActivePresentation 'ssw.Presentation
For l = 1 To pres.Slides.Count
For m = pres.Slides(l).Shapes.Count To 1 Step -1
If pres.Slides(l).Shapes(m).Name Like "menu*" Then
pres.Slides(l).Shapes(m).Delete
End If
Next m
Next l
End Sub
메뉴 관련 도형들은 이름이 모두 'menu'로 시작하기 때문에 모두 지워주면 되겠습니다.
도형 삭제할 때는 항상 맨 끝 도형부터 아래로 내려오면서 삭제해야 중간에 누락되지 않습니다.
■ 개선점, 문제점 등
1) 속도: 마우스 오버시 도형을 추가하고 삭제하기 때문에 속도에 문제가 조금 있습니다.
메뉴도형을 감췄다가 보여주는 방법도 있는데 슬라이드에 보이지 않는 도형이 있는 것이 걸려서
아예 실시간으로 도형을 추가, 삭제하는 방법을 택했습니다.
2) 메뉴도형이 추가/삭제될 때 애니메이션 재시작:
만약 슬라이드에 애니메이션 특히 자동 시작 애니메이션이 있다면
메뉴에 마우스가 움직이면 도형이 추가,삭제되기 때문에 애니메이션 시퀀스가 초기화되어
애니메이션이 재시작됩니다. 마우스 움직일 때마다 애니메이션이 계속 반복되면
상당히 거슬립니다. 여기서는 맨 마지막 애니메이션 시퀀스로 가고 슬라이드쇼를 잠시 정지하도록 했습니다.
3) 메뉴구조가 단순 2단계인데 더 깊숙히 여러 단계인 경우를 생각해볼 수 있겠습니다.
그러려면 메뉴 구조체와 배열구조를 바꿔야겠습니다.
첨부파일(카테고리메뉴4.pptm)은 2010과 2016에서 테스트했습니다.
- 다운받으시면 먼저 탐색기에서 파일 속성- 차단해제 확인하시고
파일 열 때 매크로 허용해주세요.
'PPT+VBA' 카테고리의 다른 글
PPT 표(Table) 서식 복사/적용 (12) | 2020.01.27 |
---|---|
PPT 실시간 시계 혹은 타이머 추가 v2 (8) | 2019.12.21 |
PPT 실시간 시계 또는 타이머 추가 (26) | 2019.12.17 |
PPT 한글, 영문 폰트 및 기타 속성 일괄 변경하기 (19) | 2019.10.29 |
여러 PPT안의 특정 단어 검색(도형 및 VBA 코드 포함 검색) (7) | 2019.07.07 |
각 슬라이드에 한글자씩 가득차게 분할 출력 (0) | 2019.07.02 |
슬라이드 이미지 분할 인쇄 및 저장 (2) | 2019.06.08 |
VBA로 슬라이드 자동 생성 - '자주 쓰는 영어속담 50개' (4) | 2019.04.16 |
최근댓글