使用VBA批量插入幻灯片

复制内容到剪贴板

代码:

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

复制内容到剪贴板

代码:

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