时间戳

首页 > 解决方案 > 在单个宏运行时未检测到嵌入文件

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

问题描述

脚本将嵌入文件转换为其图像并将它们粘贴到嵌入文件上然后删除嵌入文件的想法（代码如下）。这是在 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

标签： excelvbapowerpointobject-detection

解决方案

替换这个：

      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

下一个

推荐阅读