1

情况:我正在运行一个宏以将图形从文件夹导入到 PowerPoint,每张幻灯片以自定义格式导入 4 个,使用我在此处找到的宏。

问题:图片的导入顺序不是由文件名完成的。如何按该顺序导入这些照片?我的文件被命名为图表 1、图表 2 等。

编码:

Sub InsertQuadFormat()

  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\"
  i = 1

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

  Set layout = Application.ActivePresentation.SlideMaster.CustomLayouts(3)
  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)) = ".png" 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 = 15
                  .Top = 70
                  .Height = 460
                  .Width = 460
              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 = 484
                  .Top = 70
                  .Height = 460
                  .Width = 460
              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 = 15
                  .Top = 296
                  .Height = 460
                  .Width = 460
              End With
          Else
              ' For 4,8,12 .... images

              Set img = slide.Shapes.AddPicture(folderName + file.Name, False, True, 200, 200)
              With img
                  .Left = 484
                  .Top = 296
                  .Height = 460
                  .Width = 460
              End With
          End If
      End If
      i = i + 1
  Next

End Sub
4

1 回答 1

0

不要在“For Each file In folder.Files”循环中进行工作。相反,使用该循环用文件夹中的文件名填充数组,对数组进行排序,然后循环遍历数组以添加图像。

于 2015-06-30T14:38:04.043 回答