PPT VBA 例程在步进模式下有效，但在运行下无效

Question

我尝试使用幻灯片上的选定图片，然后 copy/paste 将其放入占位符 （我无法从文件加载图片, 它必须来自幻灯片本身。)

当我使用 F8 一步步检查代码时，它工作正常。但是当我运行宏时，占位符保持为空。

我尝试设置Delays来给PPT足够的时间，但是无论我延迟多高，它都不起作用（Placeholder没有被填满）

有什么想法，是什么导致了这种奇怪的行为？更好的想法如何将所选图像放入模板占位符（不过也应该适用于 Mac）。感谢您的宝贵时间！

Sub SetImageIntoPlaceholder()
    Dim sImage As Shape
    Dim iSl As Integer
    Dim oSl As Slide
    Dim oPl As Shape
    On Error GoTo ErrorHandler

    If ActiveWindow.Selection.ShapeRange().Count <> 1 Then
        MsgBox "Please select only the picture you wish to place in the Placeholder", vbOKOnly Or vbCritical, Application.Name
        Exit Sub
    End If
    
    iSl = ActiveWindow.View.Slide.SlideIndex
    Set oSl = ActivePresentation.Slides(iSl)
    Set sImage = ActiveWindow.Selection.ShapeRange(1)
    sImage.Copy
    
    For Each oPl In oSl.Shapes
        If oPl.Type = msoPlaceholder Then
            With oPl
                Select Case oPl.PlaceholderFormat.Type
                    Case Is = 18
                        'Its a picture placeholder
                        Delay 4
                        oPl.Select
                        Delay 4
                        ActiveWindow.View.Paste
                        Delay 5
                        'oSl.Shapes.Paste
                        Application.CommandBars.ExecuteMso ("SlideReset")
                        'Delay 1.5
                        'sImage.Delete
                        Exit Sub
            
                    Case Else
                        ' ignore other shape types
                End Select
            End With
        End If
    Next oPl
    
ErrorHandler:
    'Resume Next
End Sub

Answer 1

尝试在复制和粘贴后添加 DoEvents。此外，尝试将复制和粘贴操作分离到单独的过程中。 VBA 应等到操作完成后再进入和退出程序。我还没有测试过，但也许是这样的。 . .

Option Explicit

Sub SetImageIntoPlaceholder()
    Dim sImage As Shape
    Dim iSl As Integer
    Dim oSl As Slide
    On Error GoTo ErrorHandler

    If ActiveWindow.Selection.ShapeRange().Count <> 1 Then
        MsgBox "Please select only the picture you wish to place in the Placeholder", vbOKOnly Or vbCritical, Application.Name
        Exit Sub
    End If
    
    iSl = ActiveWindow.View.Slide.SlideIndex
    Set oSl = ActivePresentation.Slides(iSl)
    Set sImage = ActiveWindow.Selection.ShapeRange(1)
    sImage.Copy
    
    DoEvents
    
    PastePictureInSlide oSl
    
ErrorHandler:
    'Resume Next
End Sub

Private Sub PastePictureInSlide(ByVal oSl As Slide)

    Dim oPl As Shape
    
    For Each oPl In oSl.Shapes
        If oPl.Type = msoPlaceholder Then
            With oPl
                Select Case .PlaceholderFormat.Type
                    Case Is = 18
                        'Its a picture placeholder
                        .Select
                        ActiveWindow.View.Paste
                        'oSl.Shapes.Paste
                        Application.CommandBars.ExecuteMso ("SlideReset")
                        DoEvents
                        Exit Sub
                    Case Else
                        ' ignore other shape types
                End Select
            End With
        End If
    Next oPl

End Sub

PPT VBA 例程在步进模式下有效，但在运行下无效

PPT VBA Routine works in Step Mode, but not in Run

powerpoint

vba

PPT VBA 例程在步进模式下有效，但在 运行 下无效

PPT VBA Routine works in Step Mode, but not in Run

powerpoint

vba

PPT VBA 例程在步进模式下有效，但在运行下无效