사진 일괄 삽입 매크로

관련: 지식인1, 지식인2, 지식인3, 지식인4, 지식인5

 

사진 일괄 삽입 매크로입니다.

지식인에 질문이 많이 올라올 만큼 원하는 기능입니다.

 

일단 VBA매크로를 이용하지 않고 

슬라이드 마스터의 그림 개체틀을 이용하면 

그림틀을 눌러서 원하는 위치에 원하는 크기로 그림을 넣을 수 있습니다.

 

아래 링크를 참고하세요.

https://kin.naver.com/qna/detail.naver?d1id=1&dirId=102020103&docId=410341554&qb=7Iqs65287J2065Oc66eI7Iqk7YSwIOq3uOumvCDqsJzssrTti4A=&enc=utf8&section=kin.qna&rank=1&search_sort=0&spq=0#answer2 

ppt 안에 그림 크기

 

여기서는 그림을 하나하나 클릭하지 않고 한꺼번에 삽입하는 방법을 알아보겠습니다.

 

 

원래 파워포인트 자체 기능으로 삽입 - 사진 앨범으로도 할 수 있는데 

이 VBA매크로는 슬라이드 마스터에 자신이 원하는 레이아웃을 만들어 놓고 

사진을 일괄 삽입할 수 있고, 그림도형의 서식을 바꿀 수 있어 좀더 유연한 방법입니다.

 

보기 - 슬라이드마스터의 첫번째 레이아웃의 '사진_x' 도형이 중요합니다.

한 슬라이드 당 원하는 사진의 갯수만큼 사진_1, 사진_2,~ 사진_x 도형을 배치합니다.

도형의 서식도 복사하기 때문에 도형 서식도 미리 지정해놓으면 좋습니다.

특히 윤곽선을 두껍게 해 놓으면 슬라이드 사진에 테두리가 생기게 됩니다.

추가로 바닥글 위치 가운데에 페이지 번호도 삽입이 됩니다.

(원하지 않는 경우 소스의 페이지번호 부분 5줄을 주석처리하세요.) 

 

Option Explicit
Option Compare Text         '대소문자 무시
Const SPR As String = "\"   '폴더 구분문자
Sub Macro()
 
    Dim pres As Presentation
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Long, c As Integer, pCount As Integer, total As Long
    Dim SW!, SH!
    Dim FD As FileDialog
    Dim Files() As String, ext As String
    Dim clayout As CustomLayout
    
    Set pres = ActivePresentation
    With pres.PageSetup
        SW = .SlideWidth: SH = .SlideHeight
    End With
    '폴더 선택
    'Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    '파일 선택
    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    With FD
        .Title = "이미지파일 선택"
        .ButtonName = "선택완료"
        .InitialFileName = pres.Path & SPR
        If .Show = -1 Then
            With .SelectedItems
                For i = 1 To .Count
                    ext = Right(.Item(i), 4)
                    If ext Like ".jpg" Or ext Like ".png" Then 'JPG 나 PNG이미지
                        c = c + 1
                        ReDim Preserve Files(1 To c)
                        Files(c) = .Item(i)
                    End If
                Next i
            End With
        Else
            Exit Sub
        End If
        
    End With
    
    '사진 삽입 준비
    total = c
    If total < 1 Then MsgBox "사진이 없습니다.": Exit Sub
    Set clayout = pres.Designs(1).SlideMaster.CustomLayouts(1) ' 슬라이드마스터 첫번째 레이아웃 선택
     
    For Each shp In clayout.Shapes
        If shp.Name Like "사진_*" Then pCount = pCount + 1
    Next shp
    If pCount = 0 Then MsgBox "슬라이드마스터의 첫번째 레이아웃에 사진 도형이 없습니다." & vbNewLine & vbNewLine & _
        "레이아웃에 '사진_1, 사진_2...' 등을 추가하세요.": Exit Sub
        
    '사진 삽입
    For i = 1 To total
        '슬라이드 추가
        c = (i - 1) Mod pCount + 1
        If c = 1 Then
            Set sld = pres.Slides.AddSlide(pres.Slides.Count + 1, clayout)
            '페이지번호
            Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, SH - 30, SW, 30)
            shp.TextFrame.TextRange.Text = Int((i - 1) / pCount) + 1 & " / " & Int((total - 1) / pCount) + 1
            shp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
            shp.TextFrame.TextRange.Font.Size = 10
            shp.Name = "Page No."
        End If
        If sld Is Nothing Then MsgBox "Failed to create a slide with the layout": Exit For

        With clayout.Shapes("사진_" & c)
            .PickUp '사진틀 서식 복사
            Set shp = sld.Shapes.AddPicture(FileName:=Files(i), LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
                Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
            shp.Apply   '사진틀 서식 적용
            shp.Name = "사진_" & c & "_" & Mid(Files(i), InStrRev(Files(i), SPR) + 1) '사진 파일명
        End With
        
    Next i
     
    
End Sub

 

그림이 있는 폴더를 선택할 수도 있는데 이 버전은 그림파일을 직접 선택하는 방식입니다.

하나씩 선택하면 그때마다 슬라이드가 계속 추가됩니다.

​

기본 레이아웃은 사진 4개씩입니다.

다른 모양을 원할 경우

슬라이드 마스터 첫번째 레이아웃에

사진_1, 사진_2, 사진_3,~~ 사진_6~~~ 등을 넣어두고 매크로를 실행하면 됩니다.

아니면 아래 영상처럼 미리 레이아웃을 여러개 만들어 두고

매크로 실행전에 원하는 레이아웃을 맨 앞으로 이동시켜줘도 됩니다.

​

실행 영상입니다.

 

 

그림삽입4.pptm

0.05MB

첨부파일은 차단해제 권장하고 매크로 허용해서 열어야 합니다.

​

매크로는 빠른 실행에 추가하면 Alt-숫자키로 빨리 실행할 수 있습니다.

 

 

# # # # # # # # # # # # #

 

슬라이드 마스터 1번 레이아웃에 사진_1만 들어가게 약간 수정하여

A4세로에 사진 1장씩 가득차게 삽입하는 예시입니다.

그림삽입_A4세로_사진1장씩가득차게.pptm

0.05MB

 

# # # # # # # # # # # # #

 

추가로 일반 도형위에 그림을 삽입하는 방법입니다.

 

슬라이드에 그림이 들어갈 위치에 네모 도형을 그려줍니다.

도형의 이름은 Alt-F10누르고 Pic_1, Pic_2,,,,,등으로 바꿔줘야 합니다.

Alt-F8누르고 매크로를 실행해서 사진들을 선택하면 됩니다.

실행영상:

참고로 여러번 실행시 최근 경로가 뜨도록 Pic_1도형의 태그에 최근 경로가 저장됩니다.

최근경로삭제 매크로로 삭제할 수 있습니다.

 

자동사진삽입1.pptm

0.05MB

여러슬라이드에 삽입하는 경우

자동사진삽입2.pptm

0.06MB