Add Button to msoControlPopup ?

[Soniya]

Hi,

Is it possible to add a button to a custom popupmenu item
(msoControlPopup)


TIA
Soniya

 

[Bob Phillips]

Soniya,

Do you mean sub-menus, like this?

Dim oCB As CommandBar
Dim iHelpMenu As Integer
Dim oCBCtl As CommandBarControl

On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("CD
Player").Delete
On Error GoTo 0

Set oCB = Application.CommandBars("Worksheet Menu Bar")

iHelpMenu = oCB.Controls("Help").Index

Set oCBCtl = oCB.Controls.Add(Type:=msoControlPopup, Before:=iHelpMenu)
oCBCtl.Caption = "CD Player"

With oCBCtl
With .Controls.Add(Type:=msoControlPopup)
.BeginGroup = True
.Caption = "Play Controls"
With .Controls.Add(Type:=msoControlButton)
.Caption = "Play CD"
.OnAction = "CDActions"
.Enabled = True
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Stop CD"
.OnAction = "CDActions"
.Enabled = True
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Pause CD"
.OnAction = "CDActions"
.Enabled = False
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Resume CD"
.OnAction = "CDActions"
.Enabled = False
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Pause CD"
.OnAction = "CDActions"
.Enabled = False
End With
End With
With .Controls.Add(Type:=msoControlButton)
.BeginGroup = True
.Caption = "Eject cd"
.OnAction = "CDActions"
.Enabled = False
End With
With .Controls.Add(Type:=msoControlButton)
.BeginGroup = True
.Caption = "Prev Track"
.OnAction = "CDActions"
.Enabled = False
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Next Track"
.OnAction = "CDActions"
.Enabled = True
End With
End With

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Soniya]

Sorry, I have to revise my question

Is it possible to add FaceID to a custom popupmenu item
(msoControlPopup)



TIA
Soniya

 

[Bob Phillips]

Soniya,

I have not seen one in any menus, and using .FaceiD on a popup throws an
error in my tests, so it suggests not. Trying to paste an image onto it
doesn't work either.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)