VBA/파워포인트/사진정리 - 2. 사진 정열

슬라이드에 삽입된 사진들을 정리하는 메인 프로시저다.

파일 목록 가져오기처럼 여기서 사용자 입력값을 모두 입력한다. 파일 목록의 키 디멘전과 총 디멘전 수를 정한다. 그리고 사진을 배치할 픽셀 위치와 사진 크기를 슬라이드 당 사진 수에 따라 미리 정한다.

루프 종료 조건을 주기 위해 슬라이드 수를 세어 변수에 저장한다.

프로세스를 시작할 지점을 알기 위해 현재 화면 상 슬라이드 번호를 확인한다.

그런 다음, 현재 슬라이드부터 마지막 슬라이드까지 아래의 절차를 반복한다.

1. Do While slideIdx < slideCount + 1: 슬라이드 인덱스가 slideCount보다 작은 동안 루프를 실행. slideCount는 총 슬라이드 수.
2. Debug.Print "Working: Slide " & slideIdx: 디버깅을 위해 현재 작업 중인 슬라이드의 인덱스를 출력.
3. Set sld = ppt.Slides(slideIdx): 현재 작업 중인 슬라이드를 설정.
4. Set shps = sld.Shapes: 현재 슬라이드에 있는 모든 도형(Shapes)을 가져온다.
5. Debug.Print shps.Count: 디버깅을 위해 현재 슬라이드의 도형 수를 출력.
6. If shps.Count = 0 Then ...: 만약 현재 슬라이드에 도형이 하나도 없다면, slideCount를 줄이고 현재 슬라이드를 삭제. 그렇지 않으면, 새로운 슬라이드를 현재 슬라이드 뒤에 추가.
7. Set pptLayout = ppt.Slides(slideIdx).CustomLayout: 새로 추가된 슬라이드에 현재 슬라이드의 레이아웃을 설정.
8. shpsArray = GetShapesArray(shps, True, keyDimension, dimensions): 현재 슬라이드에 있는 도형들을 배열로 가져온다.
9. ArrangePictures shps, shpsArray, positions, sizes: 도형들을 정렬하고 위치와 크기를 설정.
10. MoveShapes shpsArray, shps, newShps: 도형들을 새로운 슬라이드로 이동.
11. newSld.Select: 새로운 슬라이드를 선택.
12. sld.Delete: 현재 슬라이드를 삭제.
13. If slideIdx <> slideCount Then ...: 만약 현재 슬라이드가 마지막 슬라이드가 아니라면, 다음 슬라이드를 선택.
14. slideIdx = slideIdx + 1: 슬라이드 인덱스를 증가시켜 다음 슬라이드로 이동.
15. Loop: 루프를 다시 시작하여 모든 슬라이드에 대해 작업을 반복.

728x90

 

Sub Main_ArrangePictures()
    ' pre data
    Dim keyDimension As Integer, dimensions As Integer
    keyDimension = 2
    dimensions = 2
    
    Dim positions As Variant, sizes As Variant
    positions = Array(Array(0, 0), _
        Array(Array(0, 0), Array(480, 0)), _
        Array(Array(0, 0), Array(480, 0), Array(480, 270)), _
        Array(Array(0, 0), Array(0, 270), Array(480, 0), Array(480, 270)))
    sizes = Array(Array(960), _
        Array(540, 540), _
        Array(540, 480, 480), _
        Array(480, 480, 480, 480))
        
    ' count slides
    Dim ppt As Object
    Dim slideCount As Integer
    Set ppt = ActivePresentation
    slideCount = ppt.Slides.Count
    
    ' 현재 슬라이브번호
    Dim slideIdx As Integer
    slideIdx = ActiveWindow.View.Slide.SlideIndex
    
    ' loop for slides
    Dim pptLayout As CustomLayout
    Dim sld As Slide, newSld As Slide
    Dim shps As Shapes, newShps As Shapes
    Dim shpsArray() As Integer
    Do While slideIdx < slideCount + 1
        Debug.Print "Working: Slide " & slideIdx
        
        ' check shapes on slide
        Set sld = ppt.Slides(slideIdx)
        Set shps = sld.Shapes
        Debug.Print shps.Count
        If shps.Count = 0 Then
            slideCount = slideCount - 1
            sld.Delete
        Else
            ' add slide
            Set pptLayout = ppt.Slides(slideIdx).CustomLayout
            ppt.Slides.AddSlide slideIdx + 1, pptLayout
            
            Set newSld = ppt.Slides(slideIdx + 1)
            
            Set newShps = newSld.Shapes
            
            ' build array of shape
            shpsArray = GetShapesArray(shps, True, keyDimension, dimensions)
            
            ' arrange shapes
            ArrangePictures shps, shpsArray, positions, sizes
            
            ' copy shapes to new slide
            MoveShapes shpsArray, shps, newShps
            
            ' select new slide & delete current slide
            newSld.Select
            sld.Delete
            
            ' move to next slide
            If slideIdx <> slideCount Then
                ppt.Slides(slideIdx + 1).Select
            End If
            slideIdx = slideIdx + 1
        End If
    Loop
End Sub

이 프로시저는 슬라이드에 포함된 모든 shape의 배열을 가져오는 서브 프로시저와 사진을 정렬하는 서브 프로시저, 그리고 shape을 새 슬라이드로 이동시키는 것 등 세 개의 서브 프로시저를 사용한다.

Shape의 배열 생성

VBA/파워포인트/사진정리 - 2.1. Shapes 배열 생성

VBA/파워포인트/사진정리 - 2.1. Shapes 배열 생성

사진 정렬

VBA/파워포인트/사진정리 - 2.2. 사진 정렬

VBA/파워포인트/사진정리 - 2.2. 사진 정렬

Shape 이동

VBA/파워포인트/사진정리 - 2.3. Shape 이동

VBA/파워포인트/사진정리 - 2.3. Shape 이동