单个宏运行时未检测到嵌入文件

Question

脚本将嵌入式文件转换为其图像并将其粘贴到嵌入式文件上，然后删除嵌入式文件的想法(代码如下)。这是在vba powerpoint中完成的。当我在幻灯片中嵌入公式和嵌入图像时，出现了一个问题。该脚本在第一次运行时会检测幻灯片中3个嵌入公式中的2个和3个嵌入图像中的1个，并将它们转换为它们的图像。第二次运行脚本，它检测到剩下的一个等式，然后当我第三次运行脚本时，它检测到剩余的图像。因此，在脚本运行中检测到6个嵌入项3次。知道问题出在哪里吗。

enter code here

 Sub ConvertAllShapesToPic()
Dim oSl As Slide
Dim oSh As Shape
Dim k
k = 0
With ActivePresentation
    z = .Slides(.Slides.Count).SlideNumber
    MsgBox z, vbDefaultButton1, "Total Slides"
End With


For Each oSl In ActivePresentation.Slides
          For Each oSh In oSl.Shapes
        Select Case oSh.Type
            Case msoChart, msoEmbeddedOLEObject, msoLinkedOLEObject
                ConvertShapeToPic oSh
                k = 1
            Case Else

        End Select
    Next
Next

If k = 1 Then
MsgBox "Embedded files replaced by their Images", vbDefaultButton1
Else
MsgBox "Embedded files already replaced by their Images", vbDefaultButton1
End If

End Sub

Sub ConvertShapeToPic(ByRef oSh As Shape)
Dim oNewSh As Shape
Dim oSl As Slide
Dim y

Set oSl = oSh.Parent
oSh.Copy
Set oNewSh = oSl.Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)

With oNewSh
    .Left = oSh.Left
    .Top = oSh.Top

    Do
        .ZOrder (msoSendBackward)
    Loop Until .ZOrderPosition = .ZOrderPosition
End With

For y = oSl.TimeLine.MainSequence.Count To 1 Step -1
    If oSh Is oSl.TimeLine.MainSequence.Item(y).Shape Then
    oSl.TimeLine.MainSequence.Item(y).Shape = oNewSh
    End If
Next y

oSh.Delete

    End Sub

Answer 1

替换为：

      For Each oSh In oSl.Shapes
    Select Case oSh.Type
        Case msoChart, msoEmbeddedOLEObject, msoLinkedOLEObject
            ConvertShapeToPic oSh
            k = 1
        Case Else

    End Select
Next

有了这个：

  ' Add Dim x as Long to the top of the routine
  For x = oSl.Shapes.Count to 1 Step -1
  Set oSh = oSl.Shapes(x)
Select Case oSh.Type
    Case msoChart, msoEmbeddedOLEObject, msoLinkedOLEObject
        ConvertShapeToPic oSh
        k = 1
    Case Else

End Select

下一步