Question

我正在尝试为PowerPoint创建一个“贴纸”宏。简而言之，我有一个按钮，用于标记选定的幻灯片，其形状为“完成”。这个宏正在运行。但是，我还需要一个宏来删除选定幻灯片上的完成贴纸。如果只选择了一张幻灯片，我现在设法删除形状。我对PowerPoint中的VBA很新。

添加贴纸宏（有效）：

Sub StickerDone()

Dim StickerText As String
Dim sld As Slide

StickerText = "Done"

Dim shp As Shape

For Each sld In ActiveWindow.Selection.SlideRange

'Create shape with Specified Dimensions and Slide Position
    Set shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, _
        Left:=0 * 28.3464567, Top:=0 * 28.3464567, Width:=80, Height:=26.6)

'FORMAT SHAPE
    'Shape Name
        shp.Name = "StickerDone"

    'No Shape Border
        shp.Line.Visible = msoFalse

    'Shape Fill Color
        shp.Fill.ForeColor.RGB = RGB(56, 87, 35)

    'Shape Text Color
        shp.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)

    'Text inside Shape
        shp.TextFrame.TextRange.Characters.Text = StickerText

    'Center Align Text
        shp.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter

    'Vertically Align Text to Middle
        shp.TextFrame2.VerticalAnchor = msoAnchorMiddle

    'Adjust Font Size
        shp.TextFrame2.TextRange.Font.Size = 14

    'Adjust Font Style
        shp.TextFrame2.TextRange.Font.Name = "Corbel"

    'Rotation
        shp.Rotation = 0

Next sld

End Sub

删除贴纸宏（不起作用）：

Sub StickerDelete()

    Dim shp As Shape
    Dim sld As Slide

    For Each sld In ActiveWindow.Selection.SlideRange
        For Each shp In sld.Shapes
            If shp.Name Like "StickerDone" Then

                shp.Select
                shp.Delete

            End If

        Next shp

    Next sld

End Sub

Answer 1

删除正在迭代的对象通常是一个坏主意。将它们添加到数组中并在完成（内部）循环后删除它们。

试试这个：

Sub StickerDelete()

    Dim shp As Shape
    Dim sld As Slide

    ReDim ShapesToDelete(0)
    Dim ShapeCount

    For Each sld In ActiveWindow.Selection.SlideRange
        For Each shp In sld.Shapes
            If shp.Name Like "StickerDone" Then

                'shp.Select
                'shp.Delete
                ShapeCount = ShapeCount + 1
                ReDim Preserve ShapesToDelete(0 To ShapeCount)
                Set ShapesToDelete(ShapeCount) = shp

            End If

        Next shp

    Next sld

    For i = 1 To ShapeCount
        ShapesToDelete(i).Delete
    Next
End Sub

循环选定的幻灯片并删除namned形状

1 个答案: