从文件夹到PowerPoint

时间:2015-06-29 15:49:26

标签: vba powerpoint-vba powerpoint-2013

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

问题:图片导入的顺序不是由文件名完成的。我怎么能按顺序导入这些照片?我的文件名为Chart 1,Chart 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

1 个答案:

答案 0 :(得分:0)

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