T
TexKiernan
I have a treeview control with levels (level1 and level2). I'm trying to add
a popup menu when I right click on a level2 node. here is the code:
Private Sub ShowPopup(SourceType As String, SourceText As String, SourceNode
As Node)
On Error GoTo ErrorHandRTCK
Dim cmdbar As CommandBar
Dim cmdBarButton As CommandBarButton
'Delete menu first
Call DeleteAddedButtons
Call DeleteToolbar
' See what kind of node this is and
Select Case SourceType
Case "Level1"
'do nothing
Case "Level2"
'Create menu
Set cmdbar = Application.CommandBars.Add("mnuShortCut",
Position:=msoBarPopup, Temporary:=True)
'add button(s)
Set cmdBarButton = cmdbar.Controls.Add(msoControlButton, , , , True)
With cmdBarButton
.Style = msoButtonCaption
.Caption = "View Details"
.OnAction = "=VwDetails()"
End With
Set cmdBarButton = cmdbar.Controls.Add(msoControlButton, , , , True)
With cmdBarButton
.Style = msoButtonCaption
.Caption = "View History"
.OnAction = "=VwHistory()"
End With
Set cmdBarButton = cmdbar.Controls.Add(msoControlButton, , , , True)
With cmdBarButton
.Style = msoButtonCaption
.Caption = "Send A Reminder"
.OnAction = "=ReminderSend()" 'function to run when clicked
End With
Set cmdBarButton = cmdbar.Controls.Add(msoControlButton, , , , True)
With cmdBarButton
.Style = msoButtonCaption
.Caption = "Send A Reminder With Attachments"
.OnAction = "=ReminderSendA()" 'function to run when clicked
End With
'show menu
cmdbar.ShowPopup
End Select
ErrorHandRTCKExit:
Exit Sub
ErrorHandRTCK:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandRTCKExit
End Sub
Function DeleteToolbar()
'delete the added toolbar
On Error Resume Next
Application.CommandBars("mnuShortCut").Delete
End Function
Function DeleteAddedButtons()
'delete the main menu buttons
On Error Resume Next
With Application.CommandBars("mnuShortCut")
.Controls("View Details").Delete
.Controls("View History").Delete
.Controls("Send A Reminder").Delete
.Controls("Send A Reminder with Attachments").Delete
End With
End Function
Here is my problem:
I almost always get the menu to appear (think I solved that one, you can't
add a menu that already exists). However, the .onaction won't fire unless I
open the VB window?
a popup menu when I right click on a level2 node. here is the code:
Private Sub ShowPopup(SourceType As String, SourceText As String, SourceNode
As Node)
On Error GoTo ErrorHandRTCK
Dim cmdbar As CommandBar
Dim cmdBarButton As CommandBarButton
'Delete menu first
Call DeleteAddedButtons
Call DeleteToolbar
' See what kind of node this is and
Select Case SourceType
Case "Level1"
'do nothing
Case "Level2"
'Create menu
Set cmdbar = Application.CommandBars.Add("mnuShortCut",
Position:=msoBarPopup, Temporary:=True)
'add button(s)
Set cmdBarButton = cmdbar.Controls.Add(msoControlButton, , , , True)
With cmdBarButton
.Style = msoButtonCaption
.Caption = "View Details"
.OnAction = "=VwDetails()"
End With
Set cmdBarButton = cmdbar.Controls.Add(msoControlButton, , , , True)
With cmdBarButton
.Style = msoButtonCaption
.Caption = "View History"
.OnAction = "=VwHistory()"
End With
Set cmdBarButton = cmdbar.Controls.Add(msoControlButton, , , , True)
With cmdBarButton
.Style = msoButtonCaption
.Caption = "Send A Reminder"
.OnAction = "=ReminderSend()" 'function to run when clicked
End With
Set cmdBarButton = cmdbar.Controls.Add(msoControlButton, , , , True)
With cmdBarButton
.Style = msoButtonCaption
.Caption = "Send A Reminder With Attachments"
.OnAction = "=ReminderSendA()" 'function to run when clicked
End With
'show menu
cmdbar.ShowPopup
End Select
ErrorHandRTCKExit:
Exit Sub
ErrorHandRTCK:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandRTCKExit
End Sub
Function DeleteToolbar()
'delete the added toolbar
On Error Resume Next
Application.CommandBars("mnuShortCut").Delete
End Function
Function DeleteAddedButtons()
'delete the main menu buttons
On Error Resume Next
With Application.CommandBars("mnuShortCut")
.Controls("View Details").Delete
.Controls("View History").Delete
.Controls("Send A Reminder").Delete
.Controls("Send A Reminder with Attachments").Delete
End With
End Function
Here is my problem:
I almost always get the menu to appear (think I solved that one, you can't
add a menu that already exists). However, the .onaction won't fire unless I
open the VB window?