Hello Jan.
Yes, that is the code (below).
I will explain that I want. This macro(template) show menu with tools
for work with bookmarks. See screen:
http://img.photobucket.com/albums/v190/baston/bm.gif
But first you should create toolbar "bkm" and place it to left
position and add to it button of macro "mymenu".
The code:
Option Explicit
Dim cb As CommandBar
Dim cbbBM As CommandBarButton
Dim cbbSrvs As CommandBarPopup
Dim cbbShowBM As CommandBarButton 'variable - "Show bookmark"
Dim cbbSortBM As CommandBarButton '
Dim cbbRemoveBM As CommandBarPopup '
Dim cbbDelAllBM As CommandBarButton '
Dim cbbDelBM As CommandBarButton '
Dim cbbListBM As CommandBarButton '
Dim bm As Bookmark '
Dim bBkmOnRange As Boolean '
Dim bShowHS As Boolean '
Dim bFirstItem As Boolean '
Dim bFirstItemCur As Boolean '
Dim i As Long '
Sub mymenu()
'On Error Resume Next
'Check whether open documents
If Application.Documents.Count = 0 Then
MsgBox "Not open document"
Else
Set cb = CommandBars.Add("bmPopup", msoBarPopup)
bShowHS = ActiveDocument.Bookmarks.ShowHidden
ActiveDocument.Bookmarks.ShowHidden = False
'for separator of deleting bookmarks
bFirstItem = True
'for separator of current bookmarks
bFirstItemCur = True
'create item menu "Service" with popup menu
Set cbbSrvs = cb.Controls.Add(msoControlPopup)
With cbbSrvs
.Caption = "Service"
'create item "Show bookmark"
Set cbbShowBM = cbbSrvs.Controls.Add(msoControlButton)
With cbbShowBM
If ActiveWindow.View.ShowBookmarks Then
.FaceId = 1664
.Caption = "Hide bookmark"
Else
.FaceId = 0
.Caption = "Show bookmark"
End If
.OnAction = "bmShow"
End With
'create item "Sort by location"
Set cbbSortBM = cbbSrvs.Controls.Add(msoControlButton)
If ActiveDocument.Bookmarks.Count = 0 Then
cbbSortBM.Enabled = False
End If
With cbbSortBM
.Caption = IIf(bBkmOnRange, "Sort by location", "Sort by
alphabetically")
.OnAction = "bmSortLoc"
End With
End With
'create item "Remove bookmarks"
Set cbbRemoveBM = cb.Controls.Add(msoControlPopup)
If ActiveDocument.Bookmarks.Count = 0 Then
cbbRemoveBM.Enabled = False
End If
With cbbRemoveBM
.Caption = "Remove bookmarks"
.BeginGroup = True
'create item "Delete all bookmarks"
Set cbbDelAllBM = cbbRemoveBM.Controls.Add(msoControlButton)
With cbbDelAllBM
.Caption = "Delete all bookmarks"
.FaceId = 1985
.OnAction = "bmDeleteAll"
End With
'create list of deleting bookmarks
For Each bm In IIf(bBkmOnRange, ActiveDocument.Bookmarks,
ActiveDocument.Range.Bookmarks)
Set cbbDelBM = cbbRemoveBM.Controls.Add(msoControlButton)
With cbbDelBM
.Caption = bm.Name
.Style = msoButtonCaption
.Tag = bm.Name
.OnAction = "bmDel"
'set separator
If bFirstItem Then
.BeginGroup = True
bFirstItem = False
End If
End With
Next bm
End With
'create list of bookmarks subject to select type sorting
For Each bm In IIf(bBkmOnRange, ActiveDocument.Bookmarks,
ActiveDocument.Range.Bookmarks)
Set cbbListBM = cb.Controls.Add(msoControlButton)
With cbbListBM
.Caption = bm.Name
.Style = msoButtonCaption
.OnAction = "bmGoTo"
.Tag = bm.Name
'set separator
If bFirstItemCur Then
.BeginGroup = True
bFirstItemCur = False
End If
End With
Next bm
'Plasing popup menu
With CommandBars.ActionControl
' .TooltipText = "Work with bookmark"
cb.ShowPopup .Left + 25, .Top + .Height - 24
' .FaceId = 454
End With
'Restore all variable or set these is nothing
ActiveDocument.Bookmarks.ShowHidden = bShowHS
Set cb = Nothing
Set cbbSrvs = Nothing
Set cbbShowBM = Nothing
' Set cbbSortBM = Nothing
Set cbbRemoveBM = Nothing
Set cbbDelAllBM = Nothing
Set cbbDelBM = Nothing
Set cbbListBM = Nothing
End If
End Sub
'show/hide bookmark
Sub bmShow()
With ActiveWindow.View
.ShowBookmarks = Not .ShowBookmarks
End With
End Sub
'sort bookmark
Sub bmSortLoc()
bBkmOnRange = Not bBkmOnRange
With cbbSortBM
.OnAction = "mymenu"
End With
End Sub
'remove all bookmarks
Sub bmDeleteAll()
For i = ActiveDocument.Bookmarks.Count To 1 Step -1
ActiveDocument.Bookmarks(i).Delete
Next i
End Sub
'remove one bookmark
Sub bmDel()
ActiveDocument.Bookmarks(CommandBars.ActionControl.Tag).Delete
Selection.Collapse wdCollapseStart
End Sub
'Go to bookmark
Sub bmGoTo()
ActiveDocument.Bookmarks(CommandBars.ActionControl.Tag).Range.Select
End Sub
