선택된 슬라이드 내 하이퍼링크 일괄 수정

 

 

 

원래는 슬라이드를 한꺼번에 다른 프레젠테이션 파일에 붙여넣으면

하이퍼링크가 다시 계산되어 링크 페이지가 업데이트됩니다.

​

하지만 목차 슬라이드만 다른 프레젠테이션에 붙여넣거나

링크로 이동되는 슬라이드만 다른 프레젠테이션에 삽입하는 경우 등은

링크 페이지가 업데이트될 수 없습니다.

​

또한 하이퍼링크가 특정 슬라이드 페이지가 아니라 슬라이드 이름으로 링크된 경우도

자동으로 업데이트가 안될 수 있습니다.

​

이렇게 슬라이드 링크 페이지에 오차가 발생했을 때 몇페이지 앞으로 당기거나 뒤로 밀려면

VBA로 일괄로 링크 페이지를 +/- 증감시켜줄 수 있습니다.

​

첨부파일을 다운로드해서 파일 속성에서 '차단해제' 후 매크로 허용해서 열거나

현재 프레젠테이션에서 Alt+ F11 누르고 창이 뜨면 삽입 > 모듈을 추가한 뒤에 아래 코드를 붙여넣습니다.

 

Option Explicit

Sub AdjustHyperlinksInSlides()

    Dim prs As Presentation
    Dim sld As Slide
    Dim shp As Shape, hLnk As Hyperlink
    Dim usr As String, adj As Integer, addr As Integer
    
    Set prs = ActivePresentation
    usr = InputBox(ActiveWindow.Selection.SlideRange.Count & _
                "개의 선택된 슬라이드내의 하이퍼링크를 조절합니다." & vbNewLine & vbNewLine & _
                "늘리거나 줄일 페이지수를 양수 혹은 음수로 입력하세요." & vbNewLine & vbNewLine & _
                "예) 5슬라이드로 링크일 때 10을 입력시 15 슬라이드로 링크 변경", "하이퍼링크 일괄조정", 10)
    If usr = "" Then Exit Sub
    If Not IsNumeric(usr) Then MsgBox "숫자로 입력하세요.": Exit Sub
    adj = CInt(Trim(usr))
    
    '조절된 링크가 슬라이드 범위를 벗어날 때 오류
    If adj < -prs.Slides.Count Or adj > prs.Slides.Count Then _
        MsgBox "입력한 수가 슬라이드 범위를 벗어납니다.": Exit Sub
    
    '선택 슬라이드 순환
    For Each sld In ActiveWindow.Selection.SlideRange   'prs.Slides
        For Each shp In sld.Shapes
            With shp.ActionSettings(ppMouseClick)
                If .Action = ppActionHyperlink Then
                    addr = getLink(prs, .Hyperlink.SubAddress)
                    Debug.Print sld.SlideIndex, shp.Name, .Hyperlink.SubAddress, addr   '조절 이전
                    '조절된 링크가 슬라이드 범위를 벗어날 때 오류
                    If addr + adj < 1 Or addr + adj > prs.Slides.Count Then
                        MsgBox "입력한 수를 반영한 하이퍼링크가 슬라이드 범위를 벗어납니다."
                    Else
                        .Hyperlink.SubAddress = addr + adj
                    End If
                    Debug.Print "변경 결과 =>>", .Hyperlink.SubAddress '조절 결과
                End If
            End With
        Next shp
    Next sld

End Sub

'.subAddress 가 123,10,Slide10 인 경우 10을 추출
'.subAddress 가 Slide 10 일 경우 모든 슬라이드 이름을 검색해서 10을 추출
Function getLink(p As Presentation, str As String) As Integer
    Dim oSld As Slide
    getLink = 0
    If InStr(str, ",") > 0 Then
        getLink = CInt(Trim(Split(str, ",")(1)))
    Else
        For Each oSld In p.Slides
            If oSld.Name = str Then getLink = oSld.SlideIndex: Exit For
        Next oSld
    End If
End Function

 

그다음 하이퍼링크를 변경할 슬라이드들을 선택한 상태에서

Alt+F8누르고 매크로 위치는 첨부파일로 선택하고 AdjustHyperlinksInSlides 를 실행합니다.

​

 

조절할 페이지수는 링크 페이지 위치를 뒤로 밀려면 양수로 10,

반대로 앞당기려면 -10 등의 음수로 입력하면 됩니다.

-10을 입력하면 20페이지로 하이퍼링크가 10페이지 링크로 수정됩니다.

슬라이드 범위를 벗어나면 오류를 출력합니다.

참고로 없는 페이지로 링크되는 경우 링크페이지가 0슬라이드가 되어 작동하지 않게 됩니다.

​

Alft+F11창에서 Ctrl+G를 눌러서 아래와 같은 실행 결과를 확인할 수 있습니다.

6 SlideNo 290,35,슬라이드 35 35 변경 결과 =>> 285,30,슬라이드 30 7 SlideNo 289,34,슬라이드 34 34 변경 결과 =>> 284,29,슬라이드 29 8 SlideNo 288,33,슬라이드 33 33 변경 결과 =>> 283,28,슬라이드 28 9 SlideNo 287,32,슬라이드 32 32 변경 결과 =>> 282,27,슬라이드 27 10 SlideNo 286,31,슬라이드 31 31 변경 결과 =>> 281,26,슬라이드 26

하이퍼링크는 내부적으로 "슬라이드ID, 슬라이드번호, 슬라이드 이름" 형태나 "슬라이드 이름" 형태로 저장됩니다. 전자의 경우 링크를 클릭하면 슬라이드ID를 먼저 검색하고 없으면 그 다음 슬라이드 번호, 또 없으면 슬라이드 이름 순으로 검색해서 이동합니다.

​

추가로 현재 슬라이드에서 선택한 도형들에 대해서만 하이퍼링크를 조절하고 싶다면

AdjustHyperlinksOfShapes 매크로를 실행하세요.

 

Sub AdjustHyperlinksOfShapes()

    Dim prs As Presentation
    Dim sld As Slide
    Dim shp As Shape, hLnk As Hyperlink
    Dim usr As String, adj As Integer, addr As Integer
    
    Set prs = ActivePresentation
    usr = InputBox(ActiveWindow.Selection.ShapeRange.Count & _
                "개의 선택된 도형의 하이퍼링크를 조절합니다." & vbNewLine & vbNewLine & _
                "늘리거나 줄일 페이지수를 양수 혹은 음수로 입력하세요." & vbNewLine & vbNewLine & _
                "예) 5슬라이드로 링크일 때 10을 입력시 15 슬라이드로 링크 변경", "하이퍼링크 일괄조정", 10)
    If usr = "" Then Exit Sub
    If Not IsNumeric(usr) Then MsgBox "숫자로 입력하세요.": Exit Sub
    adj = CInt(Trim(usr))

    '선택 도형 순환
    For Each shp In ActiveWindow.Selection.ShapeRange   'prs.Slides
         
        With shp.ActionSettings(ppMouseClick)
            If .Action = ppActionHyperlink Then
                addr = getLink(prs, .Hyperlink.SubAddress)
                Debug.Print shp.Parent.SlideIndex, shp.Name, .Hyperlink.SubAddress, addr   '조절 이전
                '조절된 링크가 슬라이드 범위를 벗어날 때 오류
                If addr + adj < 1 Or addr + adj > prs.Slides.Count Then
                    MsgBox "입력한 수를 반영한 하이퍼링크가 슬라이드 범위를 벗어납니다."
                Else
                    .Hyperlink.SubAddress = addr + adj
                End If
                Debug.Print "변경 결과 =>>", .Hyperlink.SubAddress '조절 결과
            End If
        End With
         
    Next shp

End Sub

'.subAddress 가 123,10,Slide10 인 경우 10을 추출
'.subAddress 가 Slide 10 일 경우 모든 슬라이드 이름을 검색해서 10을 추출
Function getLink(p As Presentation, str As String) As Integer
    Dim oSld As Slide
    getLink = 0
    If InStr(str, ",") > 0 Then
        getLink = CInt(Trim(Split(str, ",")(1)))
    Else
        For Each oSld In p.Slides
            If oSld.Name = str Then getLink = oSld.SlideIndex: Exit For
        Next oSld
    End If
End Function

 

 

​

샘플 파일 첨부합니다.

​

​

AdjustLink1.pptm

0.09MB