Question

我想这很容易，但我无法弄清楚。我在Excel中有一个vba代码，打开一个Powerpoint演示文稿，找到某种类型的形状（“Retângulodecantos arredondados 9”=“圆角”矩形“）并将现有文本（MMM / AA）替换为另一个（TESTE）

<!-- Base application theme. -->
    <style name="AppTheme" parent="Theme.AppCompat.Light.DarkActionBar">
        <!-- Customize your theme here. -->
        <item name="colorPrimary">@color/colorPrimary</item>
        <item name="colorPrimaryDark">@color/colorPrimaryDark</item>
        <item name="colorAccent">@color/colorAccent</item>
        <item name="android:textViewStyle">@style/MyText</item> //MyText its custom style for font
    </style>

问题是某些幻灯片没有这种形状，所以如果找不到Sub replace() caminho_pptx = Cells(2, 2).Value mes_ano = Cells(4, 2).Value cx = "Retângulo de cantos arredondados 9" Set ObjPPT = CreateObject("PowerPoint.Application") Set ObjPresentation = ObjPPT.Presentations.Open("" & caminho_pptx & "") For i = 1 To ObjPresentation.Slides.Count ObjPresentation.Slides(i).Select On Error GoTo Prox: ObjPresentation.Slides(i).Shapes(cx).Select If ObjPresentation.Slides(i).Shapes(cx).HasTextFrame Then If ObjPresentation.Slides(i).Shapes(cx).TextFrame.HasText Then If Obj + Presentation.Slides(i).Shapes(cx).TextFrame.TextRange.Find("MMM/AA") = "MMM/AA" Then m = ObjPresentation.Slides(i).Shapes(cx).TextFrame.TextRange.Find("MMM/AA").Characters.Start ObjPresentation.Slides(i).Shapes(cx).TextFrame.TextRange.Characters(m).InsertBefore ("TESTE") ObjPresentation.Slides(i).Shapes(cx).TextFrame.TextRange.Find("MMM/AA").Delete End If End If End If Next i Prox: Next i End Sub，程序必须转到下一个i，但它不起作用。 ObjPresentation.Slides(i).Shapes(cx).Select的语法及其位置似乎都是错误的。

有什么想法吗？

Answer 1

您可以使用On Error Resume Next语句将形状指定给变量，然后在尝试使用该变量之前测试该变量是否为Nothing：

Sub replace()
    Dim oShp                  As Object

    caminho_pptx = Cells(2, 2).Value
    mes_ano = Cells(4, 2).Value
    cx = "Retângulo de cantos arredondados 9"

    Set ObjPPT = CreateObject("PowerPoint.Application")
    Set ObjPresentation = ObjPPT.Presentations.Open("" & caminho_pptx & "")

    For i = 1 To ObjPresentation.Slides.Count

        ObjPresentation.Slides(i).Select

        On Error Resume Next
        Set oShp = ObjPresentation.Slides(i).Shapes(cx)
        On Error GoTo 0
        If Not oShp Is Nothing Then
            With oShp
                If .HasTextFrame Then
                    If .TextFrame.HasText Then
                        If Obj + .TextFrame.TextRange.Find("MMM/AA") = "MMM/AA" Then
                            m = .TextFrame.TextRange.Find("MMM/AA").Characters.Start
                            .TextFrame.TextRange.Characters(m).InsertBefore ("TESTE")
                            .TextFrame.TextRange.Find("MMM/AA").Delete

                        End If
                    End If
                End If
            End With
            Set oShp = Nothing
        End If
    Next i

End Sub

On错误的正确放置和语法转到

1 个答案: