Question

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

enter image description here

我知道这可以通过“插入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

所以现在我如何修改这个以在幻灯片中插入4或6或8个图像帮助我

Answer 1

经过测试

功能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

导入图像并将它们放在powerpoint中的数组中

1 个答案: