1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
| Sub CreerMenuCtxl_mnCtxlHyperlink()
Dim cmdBar As Object 'Office.CommandBar
Dim cmdPopup As Object 'Office.CommandBarPopup
Dim ctlButton As Object, ctlTmpBtn As Object 'Office.CommandBarButton
Dim sMenu As String
Dim i As Integer
Const msoBarPopup = 5
sMenu = "mnCtxlHyperlink"
On Error Resume Next
Set cmdBar = Application.CommandBars(sMenu)
On Error GoTo 0
If Not (cmdBar Is Nothing) Then
cmdBar.Delete
End If
Set cmdBar = Application.CommandBars.Add(sMenu, msoBarPopup, False, False)
' Bouton Copier
Application.CommandBars("Database").FindControl(, 19).Copy cmdBar
' Bouton Couper
Application.CommandBars("Database").FindControl(, 21).Copy cmdBar
' Bouton Coller
Application.CommandBars("Database").FindControl(, 22).Copy cmdBar
' Bouton Coller spécial
Application.CommandBars.FindControl(, 755).Copy cmdBar
' Bouton supprimer hypertexte personnalisé, pour être visible en runtime
Set ctlButton = cmdBar.Controls.Add(msoControlButton, , , , False)
ctlButton.Caption = "Supprimer lien hypertexte"
ctlButton.Style = msoButtonIconAndCaption
ctlButton.OnAction = "=fnMyDeleteHyperlink()"
Set cmdPopup = Application.CommandBars("Form DataSheet Cell").FindControl(, 30094)
For i = 1 To cmdPopup.Controls.Count
If cmdPopup.Controls(i).ID = 3626 Then
Set ctlTmpBtn = cmdPopup.Controls(i)
ctlTmpBtn.CopyFace
ctlButton.PasteFace
End If
Next
cmdBar.Enabled = True
End Sub |
Partager