导入图像并将它们放置在一个数组中的Powerpoint

Question

我是新来的powerpoint vba编程。我遇到了一个问题，我有一个宏脚本，它基本上将路径指向我的图像所在的文件夹，然后每个幻灯片放置一个图像。 现在我想要宏脚本来提示用户是否将4或6或8图像放在幻灯片中。这是我很期待的输出如下：

我知道，这可以通过“插入画册”来完成，但问题是它只有对每张幻灯片的四个图像选项。所以这就是我写宏的原因。 这是我使用的代码：

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

测试

Funtion插入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