여러 장의 그림(사진)을 배치하는 파워포인트 매크로 기능

우선 파워포인트의 첫 페이지에 그림을 배치하고,

각 그림을 선택한 후 아래의 매크로를 실행하여,

각각의 그림의 크기와 위치에 대한 값을 확인한다.

Sub check_images()
MsgBox (ActiveWindow.Selection.ShapeRange.Left)
MsgBox (ActiveWindow.Selection.ShapeRange.Top)
MsgBox (ActiveWindow.Selection.ShapeRange.Width)
MsgBox (ActiveWindow.Selection.ShapeRange.Height)
End Sub

자동으로 삽입할 그림파일의 경로 및 파일명과

위에서 확인된 그림의 크기와 위치를 아래의 코드에 반영한다.

Sub insert_images()

Dim folder As String
folder = "D:\작업방\150930 Bearing\damaged\export\"
Dim filename As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim pptSlide As Slide
Dim pptLayout As CustomLayout
Dim oPic As Shape

Set pptLayout = ActivePresentation.Slides(1).CustomLayout

i = 2
For k = 1 To 29
For j = 1 To 4
Set pptSlide = ActivePresentation.Slides.AddSlide(i, pptLayout)
filename = folder & "time" & Format(k, "00") & "_ch" & Format(j, "0") & "_1.tif"
Set oPic = ActivePresentation.Slides(i).Shapes.AddPicture(filename, False, True, 14.125, 51.75, 691.4, 184.25)

filename = folder & "time" & Format(k, "00") & "_ch" & Format(j, "0") & "_2.tif"
Set oPic = ActivePresentation.Slides(i).Shapes.AddPicture(filename, False, True, 0, 270, 359, 269.3)

filename = folder & "time" & Format(k, "00") & "_ch" & Format(j, "0") & "_3.tif"
Set oPic = ActivePresentation.Slides(i).Shapes.AddPicture(filename, False, True, 360, 270, 359, 269.3)

i = i + 1
Next j
Next k

End Sub

위의 매크로를 실행한다.