Внедренные файлы не обнаружены за один запуск макроса - PullRequest
Новая
       5

Внедренные файлы не обнаружены за один запуск макроса

0 голосов
/ 21 октября 2018

Идея скрипта конвертировать встроенные файлы в его изображения и вставлять их во встроенные файлы, а затем удалять внедренные файлы (код ниже).Это сделано в VBA PowerPoint.Проблема возникает, когда я вставляю уравнения и внедряю изображения в слайд.При первом запуске сценарий обнаруживает 2 из 3 встроенных уравнений и 1 из 3 встроенных изображений на слайде и преобразует их в свои изображения.При повторном запуске сценария он обнаруживает одно уравнение, которое осталось, а затем, когда я запускаю сценарий в третий раз, он обнаруживает оставшееся изображение.Таким образом, 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

1 Ответ

0 голосов
/ 21 октября 2018

Заменить это: 

      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

Далее

...