엑셀 -> PPT 서칭 매크로 _v1 (버튼으로 활성화하기)

사건의 발단 : 수 백장의 요구사항 정의서의 화면 ID를 찾아서

해당 화면명과 알맞은 칸에 MAPPING해야하는 노가다 소요 발생.

 

→도저히 제시간에 마무리 할 수가 없어 VBA매크로를 사용하여

간단히 서칭을 완료할 수 있는 매크로 버튼을 활성화 하기로 마음먹음. 

 

사전요건 에시

사전요건

하나의 폴더(auto)안에 모든 파일이 모여있으면 작업하기 용이 ( 경로지정 편함 )

 

1. 검색할 텍스트가 나열된 엑셀 파일 (example.xlsm) 

※ 반드시 매크로를 적용하고 활성화할 엑셀파일은 확장자명을 xlsm(엑셀 매크로)로 변경해야함

( 그래야 모듈을 저장하고 기존의 개발도구 셋팅이 초기화되지 않음 ) 

 

2. 서치의 대상이 될 피피티 파일(example.pptx) 

 

+@ sample파일 ( 일종의 테스트 모듈 ) 사실 필요없음 ㅎㅎ

 

 

세팅

example.xlsm 파일을 키고 

파일 - 옵션 - 리본사용자 지정 - 리본메뉴 사용자 지정 탭 아래에 개발도구 체크박스를 체크한다.

예시화면

이러면 개발도구 탭이 상단에 활성화 되며 VisualBasic을 사용할 조건이 완성된다.

 

코드 분석

Sub 단추1()

     Dim xlWorkbook As Excel.Workbook
    Dim xlWorksheet As Excel.Worksheet
    Dim pptApp As Object
    Dim pptPresentation As Object
    Dim pptSlide As Object
    Dim pptShape As Object
    Dim cellVal As String
    Dim searchCol As Long
    Dim lastRow As Long
    Dim outputRow As Long
    Dim resultCol As Long
    
    ' 경로 수정하세요.
    Const pptPath As String = "C:\auto\example.pptx"

  
    ' 현재 작업 중인 Excel 파일 참조
    Set xlWorkbook = ThisWorkbook
    Set xlWorksheet = xlWorkbook.Worksheets(1)

    searchCol = 1 ' 검색할 열 지정
    resultCol = 2 ' 결과를 저장할 열 지정
    lastRow = xlWorksheet.Cells(xlWorksheet.Rows.Count, searchCol).End(xlUp).Row

    ' PPT 파일 열기
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Set pptPresentation = pptApp.Presentations.Open(pptPath)

    ' 결과 저장
    ' xlWorksheet.Cells(1, searchCol).Value = "Search Text"
    xlWorksheet.Cells(1, resultCol).Value = "Exists in PPT"

    ' 2행부터 각 검색 값에 대해 순환
    For outputRow = 2 To lastRow
        cellVal = xlWorksheet.Cells(outputRow, searchCol).Value

        ' 쉼표를 기준으로 값을 분할 -> 배열화
        searchValues = Split(cellVal, ",")
    
        ' 결과 배열 준비
        ReDim searchResults(LBound(searchValues) To UBound(searchValues))



        ' 값 검색 시작
         For i = LBound(searchResults) To UBound(searchResults)
            
            searchValue = Trim(searchValues(i))
            searchValue = Replace(searchValue, " ", "") ' 공백 제거
            searchValue = Replace(searchValue, Chr(10), "") ' 줄 바꿈(\n) 제거
            searchValue = Replace(searchValue, Chr(13), "") ' \r 제거
            
            ' PPT 슬라이드 수가 0이 아니면 검색 시작
            If pptPresentation.Slides.Count > 0 Then
                ' PPT 슬라이드 확인
                For Each pptSlide In pptPresentation.Slides
                FoundInPPT = False '초기화

                    ' 도형 확인
                    For Each pptShape In pptSlide.Shapes
                        If pptShape.HasTextFrame Then
                            If InStr(pptShape.TextFrame.TextRange.Text, searchValue) > 0 Then
                                FoundInPPT = True
                                Exit For
                            End If
                        End If
                        Next pptShape
                    ' 값을 찾았으면 for 문 종료
                    If FoundInPPT Then Exit For
                Next pptSlide
            End If

            If FoundInPPT Then '참일경우
                searchResults(i) = "Yes"
            Else '거짓일 경우
                searchResults(i) = "No"
            End If
           ' 검색 결과 메시지 박스로 출력
        MsgBox "searchValue = " & searchValue & ", searchResults(" & i & ") = " & searchResults(i)
    Next


        ' 결과 저장 준비
        Dim resultString As String
        resultString = ""
        
        For i = LBound(searchResults) To UBound(searchResults)
            resultString = resultString & searchResults(i)
            If i < UBound(searchResults) Then resultString = resultString & ", "
        Next

        ' 결과 저장
        xlWorksheet.Cells(outputRow, resultCol).Value = resultString
                
                
    Next

    ' PPT 종료
    
    pptPresentation.Close
    pptApp.Quit
    Exit Sub

End Sub

주석을 친절히 달아놨다. 

간단히 설명하자면 다음과 같다..

 

엑셀 1열의 값을 순차적으로 PPT전체 슬라이드를 기준으로 검색하여 만약 그 값이 존재시

엑셀 2열에 YES를 출력한다. 그 반대는 NO를 출력한다.

 

만약 엑셀1열에 복수 텍스트가 존재할 시 ( 예시 : Example1 , Example2 ) 공백과 Enter를 없애고

,를 기준으로 두개의 텍스트로 구분하여 결과값을 두번 출력한다. ( 예시 : Yes,Yes )

 

주의해서 봐야할 사항

1. Enter역시 vba에서는 하나의 문자로 인식한다. 따라서 예외처리를 해주지 않으면 값이 false로 출력되므로 반드시 enter도 없애주는 예외처리를 까먹지 말자.

           

<예외처리 코드>

            searchValue = Trim(searchValues(i))
            searchValue = Replace(searchValue, " ", "") ' 공백 제거
            searchValue = Replace(searchValue, Chr(10), "") ' 줄 바꿈(\n) 제거
            searchValue = Replace(searchValue, Chr(13), "") ' \r 제거

 

2. LBound와 UBound의 사용 : 지금 우리는 특정 열의 2번째 행부터 수백개의 행을 서칭해야한다. 따라서 순차적으로 for문을 이용하여 2번행부터 마지막 행까지 서칭하는데 매번 마지막 행은 다른 숫자를 보유할 것이다.

( 열의 길이가 계속 달라짐 )

 

> 우리는 반드시 내장기능을 통해 마지막행을 서칭 및 적용해주는 UBound기능을 애용하자.

간단히 말해서 L(Low)Bound는 가장 낮은 start행을 의미하고 ( 여기에서는 2행 ) RBound는 가장 마지막행을 의미한다 

 

3. 복수 서칭 기능 구현 :  ' 쉼표를 기준으로 값을 분할 -> 배열화
        searchValues = Split(cellVal, ",") 코드를 사용하면 ,를 기준으로 값을 두개로 나눠서 searchValues라고 명명한 임의의 배열에 배치해준다.

 

예를들어 kb, bb 라는 셀 값이 있다면 searchValues라는 배열에 [kb , bb]로 각각 나뉘어서 배치되는 것이다.

차후에 우리는 이것을 searchValues[0] = kb 이렇게 배열 index번호에 따라 자유롭게 꺼내서 쓸 수 있다.

 

실행

 

내가 만든 example실행 화면이다.

한 화면에 잘 보여주기 위해 임의로 매크로 실행 버튼에 매크로를 담아 활성화 했다.

 

매크로 버튼 클릭 시 화면은 다음과 같이 완료된다.

에시화면

복수 키워드 검색과 공백 / Enter에도 무리없이 값이 잘 매핑되어 적용됨을 확인할 수 있다.