엑셀->ppt서칭매크로_v2 ( 코드 리팩토링 )

좀 더 심화하여 효율적으로 개선해보았다.

기존 매크로를 버튼으로 활성화

 

주요 기능변경사항은 다음과 같다.

1. ppt명과 검색대상 text조차도 엑셀 특정열로 담아서 검색하기

2. 결과값 배열에 담아 '문자열'로 검색하기.

4. 반복문 및 초기화 옵션 간소화 ( 코드 가독성 상승 ) 

3. 특정 텍스트는 특정 ppt만 거치게 하기 → ppt 전체 열고닫는 소요 없앰

→ 필요한 검색대상 ppt만 열고 닫을 수 있어 속도 1000% 이상 빨라짐 

 

코드는 다음과 같다.

Sub CheckAndProcessPPT()
	Dim pptApp As Object , pptPres As Object
    Dim pptSlide As Object, pptShape As Object
    //검색대상 자료가 담긴 엑셀 시트
    Dim xlWorksheet As Worksheet
    //검색대상 ppt명
    Dim pptPath As String 
    Dim pptRow As Long
    Dim found As Boolean
    Dim strArray() As String, i As Integer, j As Integer
    Dim combined Result As String
   
   //작업할 엑셀시트
    Set xlWorksheet = ThisWorkbook.Worksheets("요구사항 정의서(화면) _ 기능")
    Set pptApp = CreateObject("PowerPoint.Application")
    
    //13열에 있는 ppt명을 5번행부터 순차적으로 실행하여 ppt Open -> 검색 시작
    For pptRow = 5 To xlWorksheet.Cells(xlWorksheet.Rows.Count, 13).End(xlUp).Row
    
    //검색 텍스트 배열 초기화 (한번 검색한 내용은 2번검색 안되도록)
    Erase strArray
    
    //검색 텍스트든, 대상 ppt든 하나라도 빈칸 있으면 스킵
    //문자열의 결함 & 적극사용 및 띄어쓰기, 줄바꿈 예외처리까지 한번에 -> 간소화 코드
    If xlWorksheet.Cells(pptRow, 14).Value <> "" And xlWorksheet.Cells(pptRow, 13).Value <> "" Then
    .pptPath = "C:\ 경로~~ " & Replace(xlWorksheet.Cells(pptRow, 14).Value, vbLf, "") & ".pptx"
    
    On Error Resume Next
    Set pptPres = pptApp.Presentations.Open(pptPath)
    
    If Err.Number = 0 Then
    
 		//공백 및 줄바꿈 제거 한번더. -> 보수적 코드처리
        pptSearchValue = Replace(xlWorksheet.Cells(pptRow, 13).Value, vbLf, "")
        
        //배열화 -> 값이 복수이면 ,를 기준으로 2개로 나눠서 배열에 담음 (각각 검색을 위해)
        If InStr(pptSearchValue, ",") <> 0 Then
        	strArray = Split(pptSearchValue, ",")
        Else
        	ReDim strArray(0)
            strArray(0) = pptSearchValue
        End If
        
        //결과 배열 미리 셋팅 = 검색대상 텍스트 배열과 동일한 크기일 것
        ReDim resultArray(LBound(strArray) To UBound(strArray))
        
        	//검색대상 텍스트 갯수만큼 반복
            For i = LBound(strArray) To UBound(strArray)
            	//존재여부 판단기준 초기화
                found = False
                //ppt슬라이드 내 검색 시작
                For Each pptSlide In pptPres.Slides
                	For Each pptShape In pptSlide.Shapes
                    	If pptShape.TextFrame.HasText Then
                        	If InStr(1, pptShape.TextFrame.TextRange.Text, Trim(strArray(i)), 1) Then
                            	found = True
                                Exit For
                            End If
                        End If
                    End If
                Next ppt Shape
                
                If found Then Exit For
            Next pptSlide
            
            
            //참
            If found Then
            	resultArray(i) = "yes"
            Else
            	resultArray(i) = "no"
            End If
        Next i
        
        //배열의 값을 쉼표(,)로 구분하여 하나의 문자열로 만들기
        For j = LBound(resultArray) To UBound(resultArray)
        	combinedResult = combinedResult & resultArray(j) & ","
        Next j
        
        //마지막 쉼표 제거
        combinedResult = Left(combinedResult, Len(combinedResult) -1 )
        //원하는 엑셀 셀에 결과 문자열 출력하기
        xlWorksheet.Cells(pptRow, 26).Value = combinedResult
        //초기화
        combinedResult = ""
        End If
        
        pptPres.Close
      End If
      
      
      
      Next ppt Row
      
      pptApp.Quit
      Set pptApp = Nothing
      
    End Sub

 

 

결과는 v1(version 1) 과 같다.