여러 슬라이드 보기용 슬라이드 목차 마스크 삽입하기

 

파워포인트의 여러슬라이드 보기화면입니다.

 

이번 매크로는 위 화면을 아래와 같이 변경시켜줍니다.

 

그래서 슬라이드 쇼에서 여러슬라이드 보기에서 슬라이드의 내용을 쉽게 알아볼 수 있게 만드는 것입니다.

 

표시할 내용은 각 슬라이드의 슬라이드 노트 첫번째 줄에 작성해줍니다.

 

그리고 첨부파일을 차단해제해서 열고 매크로를 허용합니다.

Alt+F8을 누르고 매크로 위치는 첨부한 pptm 을 선택하고

위에서 Add Slide Mask 매크로를 실행하세요.

 

 

매크로 실행 결과 아래처럼 각 슬라이드의 노트 내용이 슬라이드를 가득채우게 됩니다.

 

마스크 도형에 사라지기 애니메이션이 '이전효과와 함께' 로 적용되고 가장 첫번째 애니메이션으로 적용됩니다.

 

슬라이드쇼를 실행하고 해당 슬라이드에 진입하면 마스크 도형은 바로 사라지고 보이지 않게 됩니다.

 

 

마스크 도형이 더이상 필요 없다면 RemoveMask 매크로를 실행하면 모든 슬라이드의 매스크 도형을 다시 삭제해 줍니다.

 

 

참고로 슬라이드쇼에서 여러슬라이드보기(단축키 g)에서 특정 슬라이드를 선택하면 다시 다른 슬라이드를 선택할 때 여러슬라이드 보기를 또 다시 눌러줘야 하는데 아래 오토핫키 프로그램을 이용해서 마우스 우클릭하면 슬라이드가 바뀌고 나서도 여러슬라이드 보기를 계속 유지시켜 줍니다.

https://konahn.tistory.com/entry/KeepPresenterView

발표자 보기 도구 창에서 '여러 슬라이드 보기' 유지하기

 

 

 

사용된 코드:

Option Explicit

'슬라이드 노트 내용을 슬라이드 크기의 마스크 도형으로 일괄 추가
Sub AddSlideMask()

    Dim prs As Presentation
    Dim sld As Slide
    Dim shp As Shape, mshp As Shape
    Dim nt As String
    Dim SW!, SH!
    Dim eft As Effect
    
    Set prs = ActivePresentation
    With prs.PageSetup
        SW = .SlideWidth: SH = .SlideHeight '슬라이드 크기
    End With
    
    For Each sld In prs.Slides
        For Each shp In sld.NotesPage.Shapes
            '슬라이드 노트가 있으면
            If shp.PlaceholderFormat.Type = ppPlaceholderBody Then
                nt = shp.TextFrame.TextRange.Lines(1).Text  '첫째줄
                If Len(nt) > 0 Then                    'Debug.Print sld.SlideIndex, nt
                    
                    '슬라이드 크기의 텍스트 상자 삽입
                    Set mshp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, SW, SH)
                    mshp.Name = "Mask_" & sld.SlideIndex
                    mshp.Fill.ForeColor.RGB = RGB(116, 109, 147)
                    mshp.Fill.Transparency = 0.2
                    With mshp.TextFrame
                        .AutoSize = ppAutoSizeNone
                        .TextRange.Text = nt  '슬라이드 노트를 마스크 내용으로
                        .TextRange.Font.Size = 150
                        .TextRange.Font.NameFarEast = "Noto Sans KR"
                        .TextRange.Font.Color.RGB = rgbWhite
                        .WordWrap = msoTrue
                        .HorizontalAnchor = msoAnchorCenter
                        .VerticalAnchor = msoAnchorMiddle
                    End With
                    '애니메이션 추가
                    Set eft = sld.TimeLine.MainSequence.AddEffect(mshp, msoAnimEffectAppear, , msoAnimTriggerWithPrevious)
                    eft.Exit = msoTrue
                    eft.MoveTo 1    '맨 처음으로
                
                End If
            End If
        Next shp
    Next sld
    
End Sub

'마스크 도형을 일괄 삭제
Sub RemoveMask()

    Dim prs As Presentation
    Dim sld As Slide
    Dim shp As Shape, mshp As Shape
    Dim i As Long
    
    Set prs = ActivePresentation
 
    For Each sld In prs.Slides
        With sld.Shapes
            For i = .Count To 1 Step -1
                If .Item(i).Name Like "Mask_*" Then
                    .Item(i).Delete
                End If
            Next i
        End With
    Next sld
                
End Sub

 

 

실행화면

 

 

매크로 파일 첨부합니다.

슬라이드목차마스크추가1.pptm

4.51MB

 

 

참고: 지식인