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

Excel 在单个宏运行时未检测到嵌入文件,excel,vba,powerpoint,object-detection,Excel,Vba,Powerpoint,Object Detection,脚本的思想是将嵌入的文件转换为其图像,并将其粘贴到嵌入的文件上,然后删除嵌入的文件(代码如下)。这是在vba powerpoint中完成的。当我在幻灯片中嵌入方程和图像时,问题就出现了。脚本首次运行时,会检测幻灯片中3个嵌入方程式中的2个和3个嵌入图像中的1个,并将它们转换为它们的图像。第二次运行脚本时,它会检测到剩下的一个等式,然后当我第三次运行脚本时,它会检测到剩余的图像。因此,在脚本运行3次时检测到6个嵌入项。知道问题出在哪里吗 enter code here Sub ConvertA

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

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
替换此项:

      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

接下来

非常感谢。非常欢迎你;请考虑编辑你原来的问题,包括(现在)的工作代码,并标记它作为答案,以便其他人可以更容易地找到它。谢谢你想接受的答案旁边有一个勾号(认为它变灰了)-请你勾号以显示已接受的答案,好吗