Como podría modificar este archivo de submenus

Lo que quiero es que cuando le aprte al ultimo código del menu me abra una macro en este caso según va abrir word, pero en realidad lo voy a ocupar para que me abra una macro, de extracción de datos, quisiera saber si me podrían ayudar por favor señores gracias.

Sub MenuSuspenso()
Application.CommandBars("Cell").Reset
Dim cbc As CommandBarControl
'Oculta todos os comandos do botão direito
For Each cbc In Application.CommandBars("cell").Controls
cbc.Visible = False
Next cbc
'Adiciona um comando ao menu suspenso
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Word"
.OnAction = "Word"
.FaceId = 42
End With
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Acces"
.OnAction = "Acces"
.FaceId = 264
End With
'Adiciona um comando ao menu suspenso
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Excel"
.OnAction = "Excel1"
.FaceId = 263
End With
'Adiciona um comando ao menu suspenso
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Power Point"
.OnAction = "Power_Point"
.FaceId = 267
'BeginGroup coloca uma linha azul para separar o item
.BeginGroup = True
End With
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Outlook"
.OnAction = "Outlook"
.FaceId = 262
End With
With Application.CommandBars("Cell").Controls.Add(Temporary:=True)
.Caption = "Visio"
.OnAction = "Visio"
.FaceId = 266
End With
Application.CommandBars("Cell").ShowPopup
Application.CommandBars("Cell").Reset
For Each cbc In Application.CommandBars("cell").Controls
cbc.Visible = True
Next cbc
End Sub
Sub Word()
MsgBox "Voce selecionou Word ", , "MS Office''"
End Sub
Sub Acces()
MsgBox "Voce selecionou Acces ", , "MS Office''"
End Sub
Sub Excel1()
MsgBox "Voce selecionou Excel ", , "MS Office''"
End Sub

Sub Power_Point()
MsgBox "Voce selecionou Power Point ", , "MS Office''"
End Sub
Sub Outlook()
MsgBox "Voce selecionou Outlook ", , "MS Office''"
End Sub
Sub Visio()
MsgBox "Voce selecionou Visio ", , "MS Office''"
End Sub