VBA 删除特定形状

Question

我在 Mac 上为 MS powerpoint 2011 制作了 VBA 宏。我真的不喜欢 VBA，但设法让 12 个带有文本的形状出现在屏幕上，但我基本上以这里为起点。我的修改可能不是做到这一点的最佳方式，但它确实有效。

但现在我想创建另一个宏，它可以让从Dim Shp As Shape 到Dim Shp11 As Shape 命名的形状在宏执行后消失或删除。我尝试了很多东西，但总是出错。非常感谢这里的一些帮助..

我也不知道如何在 MS PowerPoint 2011 for Mac 中使用宏制作加载项。有人可能有想法吗？

非常感谢！

澄清：

这个宏背后的想法是，显示应该在 ppt 中使用的颜色值，我认为打开和关闭这些颜色会很好 - 无论你在哪张幻灯片中。

所以，再说一遍：代码看起来很糟糕，但我不是一个大程序员；）

Sub show_ci_colors()

'PURPOSE:Create a Text Box Shape and Reformat it
'SOURCE: www.TheSpreadsheetGuru.com

Dim Sld As Slide
Dim Shp As Shape
Dim Shp1 As Shape
Dim Shp2 As Shape
Dim Shp3 As Shape
Dim Shp4 As Shape
Dim Shp5 As Shape
Dim Shp6 As Shape
Dim Shp7 As Shape
Dim Shp8 As Shape
Dim Shp9 As Shape
Dim Shp10 As Shape
Dim Shp11 As Shape

'ERROR HANDLING
If ActivePresentation.Slides.Count = 0 Then
    MsgBox "You do not have any slides in your PowerPoint project."
    Exit Sub
End If

Set Sld = Application.ActiveWindow.View.Slide

'Create shape with Specified Dimensions and Slide Position
    Set Shp = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=20, Width:=60, Height:=40)

    Set Shp1 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=62, Width:=60, Height:=40)

    Set Shp2 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=104, Width:=60, Height:=40)

    Set Shp3 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=146, Width:=60, Height:=40)

    Set Shp4 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=186, Width:=60, Height:=40)

    Set Shp5 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=230, Width:=60, Height:=40)

    Set Shp6 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=272, Width:=60, Height:=40)

    Set Shp7 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=314, Width:=60, Height:=40)

    Set Shp8 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=356, Width:=60, Height:=40)

    Set Shp9 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=398, Width:=60, Height:=40)

    Set Shp10 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=440, Width:=60, Height:=40)

    Set Shp11 = Sld.Shapes.AddShape(Type:=msoShapeRectangle, _
    Left:=-80, Top:=482, Width:=60, Height:=40)



'FORMAT SHAPE
 'Shape Name
    Shp.Name = "My Header"

'No Shape Border
    Shp.Line.Visible = msoFalse
    Shp.Shadow.Visible = msoFalse
    Shp1.Line.Visible = msoFalse
    Shp1.Shadow.Visible = msoFalse
    Shp2.Line.Visible = msoFalse
    Shp2.Shadow.Visible = msoFalse
    Shp3.Line.Visible = msoFalse
    Shp3.Shadow.Visible = msoFalse
    Shp4.Line.Visible = msoFalse
    Shp4.Shadow.Visible = msoFalse
    Shp5.Line.Visible = msoFalse
    Shp5.Shadow.Visible = msoFalse
    Shp6.Line.Visible = msoFalse
    Shp6.Shadow.Visible = msoFalse
    Shp7.Line.Visible = msoFalse
    Shp7.Shadow.Visible = msoFalse
    Shp8.Line.Visible = msoFalse
    Shp8.Shadow.Visible = msoFalse
    Shp9.Line.Visible = msoFalse
    Shp9.Shadow.Visible = msoFalse
    Shp10.Line.Visible = msoFalse
    Shp10.Shadow.Visible = msoFalse
    Shp11.Line.Visible = msoFalse
    Shp11.Shadow.Visible = msoFalse

'Shape Fill Color
    Shp.Fill.ForeColor.RGB = RGB(4, 110, 151)                   'BLUE 700
    Shp.Fill.BackColor.RGB = RGB(4, 110, 151)                   'BLUE 700

    Shp1.Fill.ForeColor.RGB = RGB(6, 166, 227)                  'BLUE 300
    Shp1.Fill.BackColor.RGB = RGB(6, 166, 227)                  'BLUE 300

    Shp2.Fill.ForeColor.RGB = RGB(133, 199, 226)               'BLUE 100
    Shp2.Fill.BackColor.RGB = RGB(133, 199, 226)                'BLUE 100

    Shp3.Fill.ForeColor.RGB = RGB(23, 152, 131)                 'GREEN
    Shp3.Fill.BackColor.RGB = RGB(23, 152, 131)                 'GREEN

    Shp4.Fill.ForeColor.RGB = RGB(254, 201, 5)                     'YELLOW
    Shp4.Fill.BackColor.RGB = RGB(254, 201, 5)                     'YELLOW

    Shp5.Fill.ForeColor.RGB = RGB(189, 57, 47)    'RED 700
    Shp5.Fill.BackColor.RGB = RGB(189, 57, 47)    'RED 700

    Shp6.Fill.ForeColor.RGB = RGB(225, 92, 80)   'RED 300
    Shp6.Fill.BackColor.RGB = RGB(225, 92, 80)   'RED 300

    Shp7.Fill.ForeColor.RGB = RGB(237, 140, 52)   'ORANGE
    Shp7.Fill.BackColor.RGB = RGB(237, 140, 52)   'ORANGE

    Shp8.Fill.ForeColor.RGB = RGB(64, 64, 64)   'GREY 700
    Shp8.Fill.BackColor.RGB = RGB(64, 64, 64)   'GREY 700

    Shp9.Fill.ForeColor.RGB = RGB(84, 84, 84)   'GREY 600
    Shp9.Fill.BackColor.RGB = RGB(84, 84, 84)   'GREY 600

    Shp10.Fill.ForeColor.RGB = RGB(189, 189, 198)   'GREY 300
    Shp10.Fill.BackColor.RGB = RGB(189, 189, 198)   'GREY 300

    Shp10.Fill.ForeColor.RGB = RGB(189, 189, 198)   'GREY 300
    Shp10.Fill.BackColor.RGB = RGB(189, 189, 198)   'GREY 300

    Shp11.Fill.ForeColor.RGB = RGB(238, 238, 238)   'GREY 200
    Shp11.Fill.BackColor.RGB = RGB(238, 238, 238)   'GREY 200


'Shape Text Color
    Shp.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
    Shp11.TextFrame.TextRange.Font.Color.RGB = RGB(64, 65, 65)

'Text inside Shape
    Shp.TextFrame.TextRange.Characters.Text = "Blue 700" & Chr(10) & "4 / 110 / 151"
    Shp1.TextFrame.TextRange.Characters.Text = "Blue 300" & Chr(10) & "6 / 166 / 227"
    Shp2.TextFrame.TextRange.Characters.Text = "Blue 100 " & Chr(10) & "133 / 199 / 226"
    Shp3.TextFrame.TextRange.Characters.Text = "Green" & Chr(10) & "23 / 152 /131"
    Shp4.TextFrame.TextRange.Characters.Text = "Yellow" & Chr(10) & "254 / 201 / 5"
    Shp5.TextFrame.TextRange.Characters.Text = "Red 700" & Chr(10) & "189 / 57 / 47"
    Shp6.TextFrame.TextRange.Characters.Text = "Red 300" & Chr(10) & "225 / 92 / 80"
    Shp7.TextFrame.TextRange.Characters.Text = "Orange" & Chr(10) & "237 / 140 52"
    Shp8.TextFrame.TextRange.Characters.Text = "Grey 700" & Chr(10) & "64 / 65 / 65"
    Shp9.TextFrame.TextRange.Characters.Text = "Grey 600" & Chr(10) & "84 / 84 / 84"
    Shp10.TextFrame.TextRange.Characters.Text = "Grey 300" & Chr(10) & "189 / 189 / 189"
    Shp11.TextFrame.TextRange.Characters.Text = "Grey 200" & Chr(10) & "238 / 238 / 238"


'Center Align Text
    Shp.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp1.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp2.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp3.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp4.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp5.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp6.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp7.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp8.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp9.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp10.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter
    Shp11.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = msoAlignCenter

'Vertically Align Text to Middle
    'Shp.TextFrame.VerticalAnchor = msoAnchorMiddle

'Adjust Font Size
    Shp.TextFrame.TextRange.Font.Size = 8
    Shp1.TextFrame.TextRange.Font.Size = 8
    Shp2.TextFrame.TextRange.Font.Size = 8
    Shp3.TextFrame.TextRange.Font.Size = 8
    Shp4.TextFrame.TextRange.Font.Size = 8
    Shp5.TextFrame.TextRange.Font.Size = 8
    Shp6.TextFrame.TextRange.Font.Size = 8
    Shp7.TextFrame.TextRange.Font.Size = 8
    Shp8.TextFrame.TextRange.Font.Size = 8
    Shp9.TextFrame.TextRange.Font.Size = 8
    Shp10.TextFrame.TextRange.Font.Size = 8
    Shp11.TextFrame.TextRange.Font.Size = 8


'FONT STYLE DELETED
'Adjust Font Style
' Shp.TextFrame.TextRange.Font.Name = "Verdana"L

End Sub

Answer 1

要删除集合中的形状，您需要倒数，因此此示例说明如何从当前演示文稿的幻灯片 1 中删除所有形状：

Dim iCounter As Integer
For iCounter = ActivePresentation.Slides(1).Shapes.Count to 1 Step -1
  ActivePresentation.Slides(1).Shapes(iCounter).Delete
Next

您当然可以添加检查来决定要删除的形状类型/名称。

接下来，如果您想在 PowerPoint:mac 2011 的加载项中使用宏，请将其保存为 .ppam 文件，然后使用工具/加载项加载它... 您可能还想添加一个菜单以访问您的加载项的功能，并且您需要在 PowerPoint:mac 2011 上使用 CommandBars将帮助您入门：

Dim oMenuBar
Dim oMenu As CommandBarPopup
Dim oCtrl As CommandBarControl
Dim iTools As Integer

' Get the position of the native PowerPoint tools menu (English only)
iTools = Application.CommandBars.ActiveMenuBar.Controls("Tools").Index

' Create a new menu
Set oMenuBar = Application.CommandBars.ActiveMenuBar
Set oMenu = oMenuBar.Controls.Add(type:=msoControlPopup, Before:=iTools, Temporary:=True)
With oMenu
  .Caption = "My Menu"
  .Enabled = True
End With

' Add a control
Set oCtrl = oMenu.Controls.Add(type:=msoControlButton)
With oCtrl
  .Caption = "My Tool"
  .OnAction = "MyMacro"
End With

如果这有帮助，请为解决方案投票:-)