使用VBA批量插入幻灯片

user_eatct

① 以InsertFromFile来进行插入，无法保持源格式：

• 
  
• Sub InsertSlides()
  
• Dim FileName As String
  
• Dim K As Integer
  
• 
  
• For i = 1 To 60
  
• 
  
• FileName = "****(" & i & ").ppt" ‘注：****为文件名，包括其路径
  
• K = Application.ActivePresentation.Slides.Count
  
• 
  
• Application.ActivePresentation.Slides.InsertFromFile FileName, K
  
• 
  
• Next i
  
• 
  
• End Sub
  

复制代码

user_xcrbq

• Sub CopyWithSourceFormating()
  
• 
  
•     Dim oSource As Presentation
  
•     Dim oTarget As Presentation
  
•     Dim oSlide As Slide
  
•     Dim dlgOpen As FileDialog
  
•     Dim bMasterShapes As Boolean
  
•     Dim i As Integer
  
•     Dim FileName As String
  
• 
  
•     Set oTarget = ActivePresentation
  
• 
  
• For i = 1 To 60
  
• 
  
•         FileName = "※※ (" & i & ").ppt"    ’注 ※※为文件名称，包括路径
  
• 
  
•         Set oSource = Presentations.Open(FileName, , , False)
  
• 
  
•         For Each oSlide In oSource.Slides
  
•             oSlide.Copy
  
•             With oTarget.Slides.Paste
  
•                 .Design = oSlide.Design
  
•                 .ColorScheme = oSlide.ColorScheme
  
•                 If oSlide.FollowMasterBackground = False Then
  
•                     .FollowMasterBackground = False
  
•                     With .Background.Fill
  
•                         .Visible = oSlide.Background.Fill.Visible
  
•                         .ForeColor = oSlide.Background.Fill.ForeColor
  
•                         .BackColor = oSlide.Background.Fill.BackColor
  
•                     End With
  
•                     Select Case oSlide.Background.Fill.Type
  
•                         Case Is = msoFillTextured
  
•                             Select Case oSlide.Background.Fill.TextureType
  
•                                 Case Is = msoTexturePreset
  
•                                     .Background.Fill.PresetTextured _
  
•                                             (oSlide.Background.Fill.PresetTexture)
  
•                                 Case Is = msoTextureUserDefined
  
•                             End Select
  
•                         Case Is = msoFillSolid
  
•                             .Background.Fill.Transparency = 0#
  
•                             .Background.Fill.Solid
  
•                         Case Is = msoFillPicture
  
•                             With oSlide
  
•                                 If .Shapes.Count > 0 Then .Shapes.Range.Visible = False
  
•                                 bMasterShapes = .DisplayMasterShapes
  
•                                 .DisplayMasterShapes = False
  
•                                 .Export oSource.Path & .SlideID & ".png", "PNG"
  
•                             End With
  
•                             .Background.Fill.UserPicture _
  
•                                     oSource.Path & oSlide.SlideID & ".png"
  
•                             Kill (oSource.Path & oSlide.SlideID & ".png")
  
•                             With oSlide
  
•                                 .DisplayMasterShapes = bMasterShapes
  
•                                 If .Shapes.Count > 0 Then .Shapes.Range.Visible = True
  
•                             End With
  
•                         Case Is = msoFillPatterned
  
•                             .Background.Fill.Patterned _
  
•                                     (oSlide.Background.Fill.Pattern)
  
•                         Case Is = msoFillGradient
  
•                             Select Case oSlide.Background.Fill.GradientColorType
  
•                                 Case Is = msoGradientTwoColors
  
•                                     .Background.Fill.TwoColorGradient _
  
•                                             oSlide.Background.Fill.GradientStyle, _
  
•                                             oSlide.Background.Fill.GradientVariant
  
•                                 Case Is = msoGradientPresetColors
  
•                                     .Background.Fill.PresetGradient _
  
•                                             oSlide.Background.Fill.GradientStyle, _
  
•                                             oSlide.Background.Fill.GradientVariant, _
  
•                                             oSlide.Background.Fill.PresetGradientType
  
•                                 Case Is = msoGradientOneColor
  
•                                     .Background.Fill.OneColorGradient _
  
•                                             oSlide.Background.Fill.GradientStyle, _
  
•                                             oSlide.Background.Fill.GradientVariant, _
  
•                                             oSlide.Background.Fill.GradientDegree
  
•                             End Select
  
•                         Case Is = msoFillBackground
  
•                     End Select
  
•                 End If
  
•             End With
  
•         Next oSlide
  
•         oSource.Close
  
•         Set oSource = Nothing
  
• 
  
•     Next i
  
• End Sub
  

复制代码

user_ylyem

谢谢分享，学习了，以后可能会用到。

miaomimi

虽然 不会 但是真了不起

hkdgniao

谢谢楼主分享