[chatGPT 파워포인트] 사진첩 만들기

사진첩을 자동으로 만들어주는 파워포인트를 만들었습니다.

 

아래 파일을 다운로드 받고▼

사진첩만들기.pptm

0.04MB

 

메뉴에서 개발도구 -> Visual Basic으로 이동해주세요▼

 

"파워포인트 개발도구 활성화방법"검색하면 방법을 쉽게 찾을 수 있습니다.

 

실행하면 이렇게 됩니다.

 

 

단 한번의 질문으로 위 파워포인트를 만드는 vba 코드를 만들 수 있었습니다.▼

 

PowerPoint VBA 사진첩

#1

파워포인트의 vba를 이용해서 사진첩을 만들것입니다. 첫번째 슬라이드는 메인화면입니다. 두번째 슬라이드부터 사진들이 들어갑니다. 첫번째 매크로는 다음과 같은 기능을 수행합니다. - 폴더를 불러와서 그 폴더의 모든 사진을 각 슬라이드의 중앙에 배치합니다. - 슬라이드의 중앙에 사진을 배치한 뒤에 사진을 강조할 수 있는 효과를 줍니다. - 사진의 밑에는 사진의 이름을 배치합니다. - 사진이 지나치게 큰 경우에는 적당히 크기를 조절합니다. 두 번째 매크로는 다음과 같은 기능을 수행합니다. - 입력창을 띄우고, 입력창에 숫자를 입력하면 그 숫자에 맞는 슬라이드로 이동합니다. 모든 슬라이드의 좌측 하단에 두 번째 매크로를 수행할 수 있는 버튼을 생성합니다. 이때, 버튼의 이름을 '숫자로 이동'으로 하십시오. 위 사항을 모두 만족하는 vba코드를 만들어주십시오.

#2

아래 코드는 주어진 요구사항에 맞게 작성되었습니다. 코드를 복사하여 PowerPoint VBA 편집기에 붙여넣으십시오.

1. PowerPoint를 엽니다.
2. Alt + F11 키를 눌러 VBA 편집기를 여십시오.
3. 왼쪽 창에서 프로젝트의 "Microsoft PowerPoint Objects" 폴더를 찾습니다.
4. "ThisPresentation"을 더블 클릭하여 코드 창을 엽니다.
5. 아래 코드를 복사하여 코드 창에 붙여넣습니다.

vba
Option Explicit

Sub CreatePhotoAlbum()
    Dim mainSlide As Slide
    Dim folderPath As String
    Dim file As String
    Dim imgSlide As Slide
    Dim img As Shape
    Dim imgName As Shape
    Dim slideIndex As Integer
    Dim newWidth As Single
    Dim newHeight As Single
    Dim maxHeight As Single
    Dim maxWidth As Single
    Dim aspectRatio As Single
    
    ' 메인 슬라이드 생성
    Set mainSlide = ActivePresentation.Slides.Add(1, ppLayoutBlank)
    
    ' 폴더 경로 선택
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        End If
    End With
    
    If folderPath = "" Then Exit Sub

    ' 폴더에서 이미지 파일 찾기
    file = Dir(folderPath & "\*.*")

    ' 슬라이드의 최대 너비와 높이 설정
    maxWidth = ActivePresentation.PageSetup.SlideWidth * 0.9
    maxHeight = ActivePresentation.PageSetup.SlideHeight * 0.8

    slideIndex = 2

    Do While file <> ""
        If (UCase(Right(file, 3)) = "JPG") Or (UCase(Right(file, 3)) = "PNG") Or (UCase(Right(file, 4)) = "JPEG") Or (UCase(Right(file, 3)) = "GIF") Or (UCase(Right(file, 3)) = "BMP") Then
            ' 이미지 슬라이드 추가
            Set imgSlide = ActivePresentation.Slides.Add(slideIndex, ppLayoutBlank)

            ' 이미지 삽입 및 정렬
            Set img = imgSlide.Shapes.AddPicture(folderPath & "\" & file, msoFalse, msoTrue, 0, 0)
            img.LockAspectRatio = msoTrue
            aspectRatio = img.Width / img.Height

            If img.Width > maxWidth Or img.Height > maxHeight Then
                If img.Width > img.Height Then
                    newWidth = maxWidth
                    newHeight = newWidth / aspectRatio
                Else
                    newHeight = maxHeight
                    newWidth = newHeight * aspectRatio
                End If
                img.Width = newWidth
                img.Height = newHeight
            End If

            img.Left = (ActivePresentation.PageSetup.SlideWidth - img.Width) / 2
            img.Top = (ActivePresentation.PageSetup.SlideHeight - img.Height) / 2

            ' 이미지 이름 삽입
            Set imgName = imgSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, img.Left, img.Top + img.Height, img.Width, 20)
            imgName

#3

계속해서 써주세요

#4

아래 코드를 이어서 붙여넣습니다.

vba
            imgName.TextFrame.TextRange.Text = file
            imgName.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
            imgName.TextFrame.TextRange.Font.Size = 14
            
            ' 숫자로 이동 버튼 추가
            Dim goToSlideButton As Shape
            Set goToSlideButton = imgSlide.Shapes.AddShape(msoShapeActionButtonCustom, ActivePresentation.PageSetup.SlideWidth * 0.1, ActivePresentation.PageSetup.SlideHeight * 0.9, 100, 30)
            goToSlideButton.TextFrame.TextRange.Text = "숫자로 이동"
            goToSlideButton.TextFrame.TextRange.Font.Size = 12
            goToSlideButton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
            goToSlideButton.ActionSettings(ppMouseClick).Run = "GoToSlideByNumber"
            
            ' 슬라이드 인덱스 증가
            slideIndex = slideIndex + 1
        End If
        file = Dir
    Loop
End Sub

Sub GoToSlideByNumber()
    Dim slideNumber As Variant
    
    slideNumber = InputBox("슬라이드 번호를 입력하십시오:", "슬라이드로 이동")
    
    If IsNumeric(slideNumber) Then
        If slideNumber > 0 And slideNumber <= ActivePresentation.Slides.Count Then
            SlideShowWindows(1).View.GotoSlide CInt(slideNumber)
        Else
            MsgBox "올바른 슬라이드 번호를 입력하십시오.", vbExclamation, "슬라이드 번호 오류"
        End If
    ElseIf slideNumber <> "" Then
        MsgBox "올바른 슬라이드 번호를 입력하십시오.", vbExclamation, "슬라이드 번호 오류"
    End If
End Sub

이제 모든 코드를 VBA 편집기에 붙여넣었습니다. 이제 테스트를 위해 슬라이드 쇼 모드로 전환하고 첫 번째 슬라이드에서 마우스 오른쪽 버튼을 클릭한 다음 "매크로" 메뉴에서 "CreatePhotoAlbum" 매크로를 선택하십시오. 이후 사진첩을 생성하기 위해 이미지가 들어있는 폴더를 선택하십시오.

모든 슬라이드에서 숫자로 이동 버튼을 사용하여 원하는 슬라이드로 이동할 수 있습니다.

 

 

좌측상단에 슬라이드 번호가 뜨도록 해서, 사진을 더 쉽게 찾을 수 있도록 코드를 수정해보았습니다.▼

 

PowerPoint VBA 사진첩

#5

Sub GoToSlideByNumber()를 이용할 수 있도록, 슬라이드의 좌측 상단에 슬라이드 번호가 들어가도록 코드를 수정해줘, 수정해야하는 코드만 써줘

#6

코드를 수정하여 슬라이드의 좌측 상단에 슬라이드 번호를 표시하도록 다음과 같이 변경하였습니다. 아래 코드를 기존 코드에 추가하거나 수정하여 붙여넣으십시오.

vba
' 슬라이드 번호 추가
Dim slideNumberBox As Shape
Set slideNumberBox = imgSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, ActivePresentation.PageSetup.SlideWidth * 0.1, ActivePresentation.PageSetup.SlideHeight * 0.1, 50, 20)
slideNumberBox.TextFrame.TextRange.Text = CStr(slideIndex - 1)
slideNumberBox.TextFrame.TextRange.Font.Size = 14
slideNumberBox.TextFrame.TextRange.Font.Bold = msoTrue

위 코드를 기존 CreatePhotoAlbum 매크로의 다음 줄에 추가하십시오:

vba
' 이미지 이름 삽입
Set imgName = imgSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, img.Left, img.Top + img.Height, img.Width, 20)

위 코드를 추가하면 슬라이드의 좌측 상단에 슬라이드 번호가 표시됩니다. 이제 GoToSlideByNumber 매크로를 사용하면, 입력한 번호에 해당하는 슬라이드로 이동할 수 있습니다.