我想制作一个新的功能区选项卡，只有在我选择我想要的形状时才会出现。我知道使用自定义UI编辑器对于Microsoft Office或使用VBA使用以下示例制作常规选项卡：
Dim oToolbar As CommandBar
Dim oButton As CommandBarButton
Dim MyToolbar As String
' Give the toolbar a name
MyToolbar = "Kewl Tools"
On Error Resume Next
' so that it doesn't stop on the next line if the toolbar's already there
' Create the toolbar; PowerPoint will error if it already exists
Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
Position:=msoBarFloating, Temporary:=True)
If Err.Number <> 0 Then
' The toolbar's already there, so we have nothing to do
Exit Sub
End If
On Error GoTo ErrorHandler
' Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)
' And set some of the button's properties
With oButton
.DescriptionText = "This is my first button"
'Tooltip text when mouse if placed over button
.Caption = "Do Button1 Stuff"
'Text if Text in Icon is chosen
.OnAction = "Button1"
'Runs the Sub Button1() code when clicked
.Style = msoButtonIcon
' Button displays as icon, not text or both
.FaceId = 52
' chooses icon #52 from the available Office icons
End With
' Repeat the above for as many more buttons as you need to add
' Be sure to change the .OnAction property at least for each new button
' You can set the toolbar position and visibility here if you like
' By default, it'll be visible when created. Position will be ignored in PPT 2007 and later
oToolbar.top = 150
oToolbar.left = 150
oToolbar.Visible = True
NormalExit:
Exit Sub ' so it doesn't go on to run the errorhandler code
ErrorHandler:
'Just in case there is an error
MsgBox Err.Number & vbCrLf & Err.Description
Resume NormalExit:
但我想让它在某些时刻出现并消失。例如，在选择视频时，在Powerpoint中，会出现2个带有视频选项的新标签（格式和播放）。当您选择另一个不是视频的形状时，此选项卡会消失，其他选项卡会显示您选择的形状的正确选项，当您不选择任何形状时，这些特殊选项卡就会消失。
是否可以使用VBA制作它？
答案 0 :(得分：3)
是的，这是可能的。要实现这一点，您需要实现三个主要方面。
例如
在名为'Ribbon'的模块中
Private theRibbon As IRibbonUI 'Holds a variable for the ribbon when loaded on startup
Private MyTag As String 'A variable to tell the ribbon to show or what Tag to hide
'Callback for the Ribbon loading from XML
Public Sub RibbonOnLoad(Ribbon As IRibbonUI)
Set theRibbon = Ribbon
MyTag = "show"
End Sub
'Get visible callback function.
Sub GetVisible(control As IRibbonControl, ByRef visible)
If MyTag = "show" Then
visible = True
Else
If control.Tag Like MyTag Then
visible = True
Else
visible = False
End If
End If
End Sub
'This is a custom sub that invalidates the ribbon as needed.
'When invalidated it has to redraw itself
Sub RefreshRibbon(Tag As String)
MyTag = Tag
If theRibbon Is Nothing Then
MsgBox "Error, Save/Restart your presentation"
Else
theRibbon.Invalidate
End If
End Sub
在名为“Events'
的模块中'Define the new events class
Dim cPPTEvent As New clsEvents
Sub Auto_Open()
'Enable the events when the aad-in is loaded
Set cPPTEvent.PPTEvent = Application
End Sub
Sub Auto_Close()
'Disable when it is closed
Set cPPTEvent.PPTEvent = Nothing
Set cPPTEvent = Nothing
End Sub
在名为'clsEvents'的类模块中。这将检查范围内的形状，如果有任何电影媒体类型，选项卡将显示在功能区上，否则它将被隐藏。
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
Dim ppCurShape As PowerPoint.Shape
If Sel.Type = ppSelectionNone Then
RefreshRibbon ""
Exit Sub
End If
For Each ppCurShape In Sel.ShapeRange
If ppCurShape.Type = msoMedia Then
If ppCurShape.MediaType = ppMediaTypeMovie Then
RefreshRibbon "show"
Exit Sub
End If
End If
Next
RefreshRibbon ""
End Sub
当然还有功能区XML代码（取自底部的第一个引用）
<customUI onLoad="RibbonOnLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon>
<tabs>
<tab id="MyCustomTab" label="My Tab" insertAfterMso="TabHome" getVisible="GetVisible" tag="MyPersonalTab" >
<group id="customGroup1" label="Group 1">
<button id="customButton1" label="Caption 1" size="normal" onAction="Macro1" imageMso="DirectRepliesTo" />
<button id="customButton2" label="Caption 2" size="normal" onAction="Macro2" imageMso="AccountMenu" />
<button id="customButton3" label="Caption 3" size="normal" onAction="Macro3" imageMso="RegionLayoutMenu" />
</group>
<group id="customGroup2" label="Group 2">
<button id="customButton4" label="Caption 4" size="normal" onAction="Macro4" imageMso="TextAlignGallery" />
<button id="customButton5" label="Caption 5" size="normal" onAction="Macro5" imageMso="PrintPreviewClose" />
<button id="customButton6" label="Caption 6" size="normal" onAction="Macro6" imageMso="PrintPreviewShrinkOnePage" />
<separator id="MySeparator1" />
<button id="customButton7" label="Caption 7" size="large" onAction="Macro7" imageMso="ReviewPreviousComment" />
</group>
<group id="customGroup3" label="Group 3">
<menu id="MyDropdownMenu" label="My Menu" size="large" imageMso="TextAlignGallery" >
<button id="customButton8" label="Caption 8" onAction="Macro8" imageMso="TextAlignGallery" />
<button id="customButton9" label="Caption 9" onAction="Macro9" imageMso="TextAlignGallery" />
<button id="customButton10" label="Caption 10" onAction="Macro10" imageMso="TextAlignGallery" />
<button id="customButton11" label="Caption 11" onAction="Macro11" imageMso="TextAlignGallery" />
<button id="customButton12" label="Caption 12" onAction="Macro12" imageMso="TextAlignGallery" />
</menu>
</group>
</tab>
</tabs>
</ribbon>
</customUI>
更多阅读：