여러 PPT안의 특정 단어 검색(도형 및 VBA 코드 포함 검색)

제목과 같이 특정 폴더 안의 여러개의 PPT 파일 안에서 

사용자가 지정한 특정 단어가 들어있는지 검색하는 일종의 프로그램입니다.

 

위처럼 윈도우탐색기에서 .txt, .csv, .xlsx, .pptx, .html 등의 파일에 대해서는 내용 검색이 가능하지만

pptx 의 경우 어느 슬라이드에 해당 검색어가 있는지는 알 수없고 매크로 내용은 검색하지 않습니다.

 

이 프로그램은 특히 VBA 코드의 내용까지 포함하여 검색합니다.

파일이 여러개인데 사용된 문구가 들어간 파일, 슬라이드, 도형을 찾고 싶다든지

특정 코드를 사용했었는데 어디에 들어 있는지, 또 기존코드 내용을 참고하고 싶을 때 요긴하겠습니다.

 

 

검색어를 입력하고 PPT검색버튼을 누르면 위 처럼 폴더를 선택하는 창이 뜹니다.

선택한 폴더를 시작으로 하위폴더를 모두 검색합니다.

폴더와 파일이 많을수록 검색시간이 오래 걸립니다.

현재 검색하는 파일은 아래 엑셀 상태창에 보여줍니다.

 

검색결과를 아래와 같이 엑셀시트에 보여줍니다.

대상 파일의 전체경로와 파일명이 보이고 옆에 슬라이드번호와 개체이름이 나옵니다.

VBA에서 발견된 경우 VBAProject의 이름(Slide1 이나 Module1 같은)과 발견된 라인(행수)를 알려줍니다.

 

하이퍼링크를 누르면 발견된 위치를 직접 보여주는 것이 장점입니다.

만일 일반 슬라이드에서 발견되었다면 아래처럼 슬라이드를 열어서 해당개체를 선택해서

어디에 해당문자열이 있는지 알려줍니다.

만일 VBA코드에서 발견된 경우 VBE 창을 띄워서

해당 라인위치를 반전선택해서 해당 검색문자열이 정확히 어느 위치에 사용되었는지 알려줍니다.

아래 엑셀 매크로 파일을 받아 매크로컨텐츠허용해서 열고 테스트해보세요.

 

SearchPPT1.xlsm

0.04MB

 

약간 수정된 버전입니다.(2021.03.18)

SearchPPT2.xlsm

0.03MB

 

주의 사항:

 

1. 윈도우10에서는 C:\ 루트 폴더가 보안상 접근이 기본적으로 제한되어 있기 때문에

엑셀을 관리자로 실행해보세요. ​아래처럼 엑셀 아이콘 우클릭하고 관리자 권한으로 실행하세요.

아니면 파일 개수가 많지 않은 특정 하위폴더를 대상으로 검색하는 것이 효율적입니다.

 

2. VBA코드까지 검색하기 때문에 PowerPoint 파워포인트 옵션-보안센터에서
'VBA프로젝트 개체에 안전하게 접속'할 수 있도록 옵션이 체크되어 있어야 합니다.

 

3. 검색되는 ppt 파일 자체에 제한이 되어 있지 않도록 외부에서 받은 파일은 차단해제를 하세요.

 

4. 파일자체에 오류가 있는 경우 검색을 위해 해당 파일을 열 때 오류가 발생할 수 있습니다.

오류가 발생하는 파일은 파워포인트에서 다시 열어보시기 바랍니다. 오류가 있는 경우 복구한 파일을 저장하고 기존 파일은 삭제해야 오류가 발생하지 않습니다.

 

 

매크로 내용 더보기:

 

'PPT 파일내 개체내에서 특정단어를 검색합니다.
'PPT, PPTx, PPSX, PPTM, PPSM 등 .*pp* 파일을 대상으로 합니다.
'검색 결과 해당된 파일의 해당슬라이드의 해당개체를 열어줍니다.
'그룹내의 도형도 검색합니다.

'by konahn(at)naver.com

Option Explicit

Sub SearchPPT()

    Dim sht As Worksheet
    Dim sFolder As String
    Dim FSO As New FileSystemObject
      
    Set sht = ActiveSheet
    If [B1] = "" Then MsgBox "검색어를 입력하세요!": Exit Sub
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "검색을 시작할 폴더로 이동하고 '선택'버튼을 누르세요!"
        .ButtonName = "현재 폴더 선택"
        .InitialFileName = ThisWorkbook.Path & Chr(92)
        If .Show = -1 Then sFolder = .SelectedItems(1)
    End With

    If sFolder = "" Then Exit Sub
    
    [B2] = sFolder
    sht.Hyperlinks.Delete
    sht.UsedRange.Offset(2).ClearContents
 
 On Error Resume Next
    SearchFolder FSO.GetFolder(sFolder), [B1]
    Application.StatusBar = False

End Sub

Function SearchFolder(oFolder As folder, str As String)
    Dim subFolder As folder
    Dim oFile As file
    
    Dim pptApp As New PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptSld As PowerPoint.Slide
    Dim pptShp As PowerPoint.Shape
    
    Dim vbComp As VBIDE.VBComponent
    Dim vbMod As VBIDE.CodeModule
    Dim stline As Long
    Dim sht As Worksheet
    Dim rng As Range
    
    For Each subFolder In oFolder.SubFolders
        SearchFolder subFolder, str
    Next subFolder
    
    Debug.Print oFolder.Path & ":"
    For Each oFile In oFolder.Files
        Application.StatusBar = "Searching <" & oFile.Path & ">..."
        If oFile.Name Like "*.pp*" And Not oFile.Name Like "*.ppa*" Then
            Debug.Print "--- " & oFile.Path
            Set pptPres = pptApp.Presentations.Open(oFile.Path, msoTrue, , msoFalse)
            
            For Each vbComp In pptPres.VBProject.VBComponents
                stline = 1
                If vbComp.CodeModule.Find(str, stline, 1, -1, -1) Then
                    Debug.Print " --- Found in VBA code : " & vbComp.Name
                    Set sht = ActiveSheet
                    Set rng = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                    rng = rng.Row - 2
                    rng.Offset(, 1) = pptPres.FullName
                    rng.Offset(, 1).HorizontalAlignment = xlHAlignRight
                    rng.Offset(, 2) = vbComp.Name
                    rng.Offset(, 3) = stline
                    'sht.Hyperlinks.Add rng.Offset(, 1), pres.FullName
                    sht.Hyperlinks.Add rng.Offset(, 1), "", rng.Offset(, 1).Address
                
                End If
            Next vbComp
            
            For Each pptSld In pptPres.Slides
                Debug.Print "--- --- --- " & pptSld.SlideIndex & " ) Slide :"
                For Each pptShp In pptSld.Shapes
                    SearchText pptShp, str
                Next pptShp
            Next pptSld
        End If
    Next oFile
    
End Function

Function SearchText(oShp As PowerPoint.Shape, oStr As String)
    Dim pres As PowerPoint.Presentation
    Dim shp As PowerPoint.Shape
    Dim sht As Worksheet
    Dim rng As Range
    
    Debug.Print "--- --- " & oShp.Name
    If oShp.Type = msoGroup Then
        For Each shp In oShp.GroupItems
            SearchText shp, oStr
        Next shp
    Else
        If oShp.HasTextFrame Then
            Debug.Print "--- --- """ & oShp.TextFrame.TextRange & """"
            If oShp.TextFrame.TextRange Like "*" & oStr & "*" Then
                Debug.Print "--- --- * found *"
                Set pres = oShp.Parent.Parent
                Set sht = ActiveSheet
                Set rng = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                rng = rng.Row - 2
                rng.Offset(, 1) = pres.FullName
                rng.Offset(, 1).HorizontalAlignment = xlHAlignRight
                rng.Offset(, 2) = oShp.Parent.SlideIndex
                rng.Offset(, 3) = oShp.Name
                'sht.Hyperlinks.Add rng.Offset(, 1), pres.FullName
                sht.Hyperlinks.Add rng.Offset(, 1), "", rng.Offset(, 1).Address
            End If
        End If
    End If
    
End Function


'현재 통합 문서의 코드
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    Dim pptApp As New PowerPoint.Application
    Dim pres As PowerPoint.Presentation
    Dim ppres As PowerPoint.ProtectedViewWindow
    Dim sld As PowerPoint.Slide
    Dim shp As PowerPoint.Shape
    Dim sht As Worksheet
    Dim rng As Range
    Dim stline As Long
    
    Set rng = Target.Range
    Debug.Print rng.Value
    
    If rng.Value Like "*.pps*" Then
        Set ppres = pptApp.ProtectedViewWindows.Open(CStr(rng.Value))
        Set pres = ppres.Edit
        'Set pres = ppres.Presentation
        'pptApp.ActiveWindow.ViewType = ppViewSlide

        pptApp.ActiveWindow.SplitVertical = 90
        pptApp.ActiveWindow.SplitHorizontal = 80
    Else
        Set pres = pptApp.Presentations.Open(rng.Value, , , msoTrue)
    End If
    
    If IsNumeric(rng.Offset(, 1)) Then
        'If pptApp.SlideShowWindows.Count Then
            'pres.SlideShowWindow.Activate
            'pres.SlideShowWindow.View.GotoSlide CLng(rng.Offset(, 1))
            'pres.SlideShowWindow.View.GotoClick pres.SlideShowWindow.View.GetClickCount
        'Else
            Set sld = pres.Slides(CLng(rng.Offset(, 1)))
            With pres.Windows(1).View
                .GotoSlide rng.Offset(, 1)
                '.Slide.Shapes(rng.Offset(, 2)).Select
                sld.Shapes(CStr(rng.Offset(, 2))).Select
                With sld.Shapes(CStr(rng.Offset(, 2))).TextFrame.TextRange
                    .Characters(InStr(.Text, [B1]), Len([B1])).Select
                End With
            End With
        'End If
    Else
        'open VBE window and select the line
        With pres.VBProject
            .VBE.MainWindow.Visible = True
            .VBComponents(rng.Offset(, 1)).Activate
            stline = CLng(rng.Offset(, 2))
            .VBComponents(rng.Offset(, 1)).CodeModule.CodePane.Show
            .VBComponents(rng.Offset(, 1)).CodeModule.CodePane _
                .SetSelection stline, 1, stline + 1, 1
        End With
    End If
End Sub

 

지식인 링크 참조: https://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102&docId=330607982&clubid=16854404&menuid=248

 

kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020103&docId=384254201#answer1