user_eatct 发表于 2016-4-12 13:24:58

使用VBA批量插入幻灯片

① 以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 发表于 2016-4-12 15:07:17


[*]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 发表于 2016-4-12 16:45:13

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

miaomimi 发表于 2016-4-12 16:58:39

虽然 不会 但是真了不起

hkdgniao 发表于 2016-4-12 17:10:42

谢谢楼主分享
页: [1]
查看完整版本: 使用VBA批量插入幻灯片