이미지를 가져 와서 파워 포인트의 배열에 배치하기

Question

파워 포인트 프로그래밍에 익숙하다. 문제가 발생했습니다. 기본적으로 매크로 이미지가있는 폴더의 경로를 가져 와서 슬라이드 당 하나의 이미지를 배치하는 매크로 스크립트가 있습니다. 이제 매크로 스크립트를 사용하여 슬라이드에 4 또는 6 또는 8 개의 이미지를 넣을 지 여부를 묻습니다. 내가 기대하고있어 출력은 다음과 같습니다 :

내가이 "가 삽입 된 photoalbum"에 의해 수행하지만 문제는 슬라이드 당 네 개의 이미지 만 옵션이있다 할 수 있다는 것을 알고. 그래서 그것이 제가 매크로를 쓰고있는 이유입니다.

Sub CreatePictureSlideshow() 
    Dim presentation 
    Dim layout 
    Dim slide 

    Dim FSO 
    Dim folder 
    Dim file 
    Dim folderName 

    ' Set this to point at the folder you wish to import JPGs from 
    ' Note: make sure this ends with a backslash \ 
    folderName = "C:\Users\hamanda\Desktop\B2_images\" 

    ' Delete all slides and setup variables 
    Set presentation = Application.ActivePresentation 
    If presentation.Slides.Count > 0 Then 
    presentation.Slides.Range.Delete 
    End If 
    Set layout = Application.ActivePresentation.SlideMaster.CustomLayouts(1) 
    Set FSO = CreateObject("Scripting.FileSystemObject") 

    ' Retrieve the folder's file listing and process each file 
    Set folder = FSO.GetFolder(folderName) 
    For Each file In folder.Files 

    ' Filter to only process JPG images 
    If LCase(Mid(file.Name, Len(file.Name) - 3, 4)) = ".png" Then 

     ' Create the new slide and delete any pre-existing contents 
     Set slide = presentation.Slides.AddSlide(presentation.Slides.Count + 1, layout) 
     While slide.Shapes.Count > 0 
      slide.Shapes(1).Delete 
     Wend 

     ' Add the picture 
     slide.Shapes.AddPicture folderName + file.Name, False, True, 10, 10 

     ' Optional: create a textbox with the filename on the slide for reference 
     ' Dim textBox 
     ' Set textBox = slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 200, 200) 
     ' textBox.TextFrame.TextRange.Text = file.Name 
    End If 
    Next 

End Sub 

을 이제 내가 시험이

Answer 1

연료 소모량과 슬라이드 도움에 저를 4 개 또는 6 또는 8 이미지를 삽입이를 수정하는 방법 : 이 내가 사용하는 코드입니다 Mod

왼쪽, 위쪽, 높이, 너비와 같은 모양의 속성은 문제 해결에 도움이됩니다.

더 나은 이해를 위해 코드의 주석을 참조하십시오. 추가 도움이 필요하면 알려주세요. 당신은 당신이 ELSEIF 삽입해야 후 더 많은 이미지를 삽입 보면 하나의 슬라이드에 네 개의 이미지 ...를 삽입하는 코드와 Modvalue 아래

Sub CreatePictureSlideshow() 
     Dim presentation 
     Dim layout 
     Dim slide 

     Dim FSO 
     Dim folder 
     Dim file 
     Dim folderName 

     Dim i As Integer 

     'Change the folder as per your needs 

     folderName = "C:\Temp\C\" 
    i = 1 

     Set presentation = Application.ActivePresentation 
     If presentation.Slides.Count > 0 Then 
     presentation.Slides.Range.Delete 
     End If 

     Set layout = Application.ActivePresentation.SlideMaster.CustomLayouts(1) 
     Set FSO = CreateObject("Scripting.FileSystemObject") 
     Set folder = FSO.GetFolder(folderName) 

     ' loop though each image in the folder 

     For Each file In folder.Files 

     If LCase(Mid(file.Name, Len(file.Name) - 3, 4)) = ".jpg" Then 

    If i Mod 4 = 1 Then 
    ' For 1,5,9 .... images 
      Set slide = presentation.Slides.AddSlide(presentation.Slides.Count + 1, layout) 

      While slide.Shapes.Count > 0 
       slide.Shapes(1).Delete 
      Wend 

      Set img = slide.Shapes.AddPicture(folderName + file.Name, False, True, 200, 200) 
      With img 
      .Left = 0 
      .Top = 0 
      .Height = 300 
       .Width = 300 
      End With 

    ElseIf i Mod 4 = 2 Then 
    ' For 2,6,10 .... images 

    Set img = slide.Shapes.AddPicture(folderName + file.Name, False, True, 200, 200) 
      With img 
      .Left = 301 
      .Top = 0 
      .Height = 300 
       .Width = 300 
      End With 


    ElseIf i Mod 4 = 3 Then 
    ' For 3,7,11 .... images 

    Set img = slide.Shapes.AddPicture(folderName + file.Name, False, True, 200, 200) 
      With img 
      .Left = 0 
      .Top = 301 
      .Height = 250 
       .Width = 250 
      End With 

    Else 
    ' For 4,8,12 .... images 

    Set img = slide.Shapes.AddPicture(folderName + file.Name, False, True, 200, 200) 
      With img 
      .Left = 300 
      .Top = 301 
      .Height = 250 
       .Width = 250 
      End With 
    End If 


     End If 
    i = i + 1 
     Next 

    End Sub