Question

我正试图找到一种方法来合并幻灯片滑动的两个大点： PPT1：滑动1A - 滑动2A - 滑动3A - ...滑动100A PPT2：幻灯片1B - 幻灯片2B - 幻灯片3B - ...幻灯片100B

- ＆GT; PPT合并：Slide 1A - Slide 1B - Slide 2A - Slide 2B - ...

说实话，我对如何解决这个问题一无所知，非常感谢任何帮助！

由于

Answer 1

StackOverflow不是代码编写服务;这就是为什么你的问题收到了几个downvotes。

但不久前我写了一小组宏，这些宏将会＃34;堆叠＆＃34;或＆＃34;交错＆＃34;来自多个文件的幻灯片，这似乎是您在这里要求的。

使用它的代码和说明在我的一个网站上，在这里： http://www.pptools.com/merge/StackInterleave.pptm

代码的密码受到保护，但是如果您想将其用作自己版本的起点，则执行交错的部分。将所有演示文稿组合到一个没有其他文件的文件夹中，然后运行：

Public Sub Interleave()
    Call InterleavePresentations(ActivePresentation.Path & "\")
End Sub

Sub InterleavePresentations(sDir As String)
' Assembles the slides from each presentation into one
' A1, B1, C1, A2, B2, C2 and so on

    Dim sTemp As String
    Dim oTempPres As Presentation
    Dim aFiles() As String
    Dim x As Long
    Dim lSlideCount As Long
    Dim lSlideNum As Long

    sTemp = Dir$(sDir & "*.ppt")
    If Len(sTemp) = 0 Then
        Exit Sub
    End If

    ReDim aFiles(1 To 1)

    ' fill the array with filenames (but NOT directory name)
    Do While Len(sTemp) > 0
        aFiles(UBound(aFiles)) = sTemp
        ReDim Preserve aFiles(1 To UBound(aFiles) + 1)
        sTemp = Dir$
    Loop

    ' find, open and save the first "valid" file from the directory
    For x = 1 To UBound(aFiles)
        If Len(aFiles(x)) > 0 Then
            If UCase(aFiles(x)) <> UCase("stackinterleave.pptm") Then
                If UCase(aFiles(x)) <> UCase("OUTPUT.PPTX") Then
                    Set oTempPres = Presentations.Open(sDir & aFiles(x))
                    Exit For
                End If
            End If
        End If
    Next

    If oTempPres Is Nothing Then
        MsgBox "Couldn't open " & sDir & aFiles(x)
        Exit Sub
    End If

    If Len(Dir$(sDir & "OUTPUT.PPTX")) > 0 Then
        Kill (sDir & "OUTPUT.PPTX")
    End If

    With oTempPres
        .SaveAs sDir & "OUTPUT.PPTX", ppSaveAsDefault
        lSlideCount = .Slides.Count
        .Slides.Range.Delete
        ' insert slides into the new empty presentation
        For lSlideNum = 1 To lSlideCount
            For x = 1 To UBound(aFiles)
                ' but not if the array element is blank
                If Len(aFiles(x)) > 0 Then
                    ' and not if its ME
                    If UCase(aFiles(x)) <> UCase("stackinterleave.pptm") Then
                        If UCase(aFiles(x)) <> UCase("OUTPUT.PPTX") Then

                            oTempPres.Slides.InsertFromFile aFiles(x), oTempPres.Slides.Count, lSlideNum, lSlideNum

                        End If
                    End If
                End If
            Next
        Next    ' lSlidenum
        .Save

    End With

End Sub

滑动滑动组合功率点？

1 个答案: