#1
|
|||
|
|||
Macro to list all bookmarks
I have two macro routines, ListBookmarks1 and ListBookmarks2, that are intended to capture bookmarks in a Word document. ListBookmarks1 uses a for loop to get the bookmarks, while ListBookmarks2 writes the bookmarks to an array. The difference is that ListBookmarks1 ignores the bookmarks in headers, footers, shapes and other stories, while ListBookmarks2 captures all bookmarks because of the array. Apparently, bookmarks in headers, footers, and shapes aren't part of the Document.Bookmark collection. What’s odd is that ActiveDocument.Bookmarks.count produces a count of all bookmarks, including those outside the bookmark collection. ListBookmarks1 writes the bookmarks it does find to a new document, and ListBookmarks2 writes them to either a new document or a message box (depending on what code is commented out). Both include each bookmark’s location (page and line number). The problem I’m having is that I am not able to get the array to display properly in either the new Word doc or the message box. The attached test doc contains the macros and eight bookmarks – 5 in the body, 1 in the header, 1 in a shape, and 1 in a table. I have switched on the “show bookmarks” and written their names followed by “BOOKMARK” in bold italics to make them easier to find. The bookmarks are: Browser DOS Header IPadd PhysAdd Status Tablebkmk Txtbox ListBookmarks1 correctly shows 8 bookmarks with their locations (it ignores “Browser“ and “Txtbox”). ListBookmarks2 shows the first 7 but the locations are mismatched by one row. However, all bookmarks and locations are captured in the array; it is evidently the display that’s not working properly in both the document and msgbox displays. Can someone help with the displays? |
#2
|
||||
|
||||
Hi Marrick,
Try something based on the following. As coded, it adds the list to then end of the current document, but you could change that: Code:
Sub ListBkMrks() Application.ScreenUpdating = False Dim oBkMrk As Bookmark, Rng As Range, StrTxt As String, StrStory As String With ActiveDocument Set Rng = .Range.Characters.Last If .Bookmarks.count > 0 Then With Rng .Text = vbCrLf & "Bookmark" & vbTab & "Page" & vbTab & "Line" & vbTab & "Story Range" & vbTab & "Contents" For Each oBkMrk In ActiveDocument.Bookmarks .InsertAfter vbCrLf & oBkMrk.Name & vbTab .InsertAfter oBkMrk.Range.Characters.First.Information(wdActiveEndAdjustedPageNumber) .InsertAfter vbTab & oBkMrk.Range.Information(wdFirstCharacterLineNumber) Select Case oBkMrk.StoryType Case 1: StrStory = "Main text" Case 2: StrStory = "Footnotes" Case 3: StrStory = "Endnotes" Case 4: StrStory = "Comments" Case 5: StrStory = "Text frame" Case 6: StrStory = "Even pages header" Case 7: StrStory = "Primary header" Case 8: StrStory = "Even pages footer" Case 9: StrStory = "Primary footer" Case 10: StrStory = "First page header" Case 11: StrStory = "First page footer" Case 12: StrStory = "Footnote separator" Case 13: StrStory = "Footnote continuation separator" Case 14: StrStory = "Footnote continuation notice" Case 15: StrStory = "Endnote separator" Case 16: StrStory = "Endnote continuation separator" Case 17: StrStory = "Endnote continuation notice" Case Else: StrStory = "Unknown" End Select .InsertAfter vbTab & StrStory & vbTab & oBkMrk.Range.Text Next oBkMrk .Start = .Start + 1 .ConvertToTable Separator:=vbTab .Tables(1).Rows.First.Range.Font.Bold = True End With End If End With Set Rng = Nothing Application.ScreenUpdating = True End Sub Note too that the line numbers for some bookmarks will come out as -1. That's because line numbers only apply to the main story.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thanks so much, Paul - that's great. I did wonder why the -1; figured Word couldn't determine a line. Any chance you could tell me how to adapt this code so the table will be created in a new document? That's my preference (but since you made it write to the active doc, I wouldn't mind offering a choice of destination document).
I also still don't understand how your code gets all the bookmarks, when I ran loops that missed the header and shapes. |
#4
|
||||
|
||||
Hi Marrick,
Try: Code:
Sub ListBkMrks() Application.ScreenUpdating = False Dim oBkMrk As Bookmark, Rng As Range, StrTxt As String, StrStory As String, wdDocIn As Document, wdDocOut As Document, Dest Dest = MsgBox(Prompt:="Output to New Document? (Y/N)", Buttons:=vbYesNoCancel, Title:="Destination Selection") If Dest = vbCancel Then Exit Sub Set wdDocIn = ActiveDocument If Dest = vbYes Then Set wdDocOut = Documents.Add If Dest = vbNo Then Set wdDocOut = wdDocIn With wdDocIn If .Bookmarks.Count > 0 Then StrTxt = vbCr & "Bookmark" & vbTab & "Page" & vbTab & "Line" & vbTab & "Story" & Chr(160) & "Range" & vbTab & "Contents" For Each oBkMrk In .Bookmarks StrTxt = StrTxt & vbCrLf & oBkMrk.Name & vbTab StrTxt = StrTxt & oBkMrk.Range.Characters.First.Information(wdActiveEndAdjustedPageNumber) StrTxt = StrTxt & vbTab & oBkMrk.Range.Information(wdFirstCharacterLineNumber) Select Case oBkMrk.StoryType Case 1: StrStory = "Main text" Case 2: StrStory = "Footnotes" Case 3: StrStory = "Endnotes" Case 4: StrStory = "Comments" Case 5: StrStory = "Text frame" Case 6: StrStory = "Even pages header" Case 7: StrStory = "Primary header" Case 8: StrStory = "Even pages footer" Case 9: StrStory = "Primary footer" Case 10: StrStory = "First page header" Case 11: StrStory = "First page footer" Case 12: StrStory = "Footnote separator" Case 13: StrStory = "Footnote continuation separator" Case 14: StrStory = "Footnote continuation notice" Case 15: StrStory = "Endnote separator" Case 16: StrStory = "Endnote continuation separator" Case 17: StrStory = "Endnote continuation notice" Case Else: StrStory = "Unknown" End Select StrTxt = StrTxt & vbTab & StrStory & vbTab & oBkMrk.Range.Text Next oBkMrk Else MsgBox "There are no bookmarks in this document", vbExclamation GoTo Done End If End With With wdDocOut Set Rng = .Range.Characters.Last With Rng .Text = StrTxt .Start = .Start + 1 .ConvertToTable Separator:=vbTab With .Tables(1) .AutoFitBehavior wdAutoFitContent .Columns.Borders.Enable = True .Rows.Borders.Enable = True .Rows.First.Range.Font.Bold = True End With End With End With Done: Set Rng = Nothing: Set wdDocIn = Nothing: Set wdDocOut = Nothing Application.ScreenUpdating = True End Sub Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Brilliant, Paul! I don't know how you do it..I keep biting off way more than I can chew. Your help is invaluable - thanks again.
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro VBA "Save as" with bookmarks in file name string | Dom37 | Word VBA | 2 | 10-31-2011 03:28 AM |
Bookmarks for a PDF? | Ownaholic | Word | 0 | 10-30-2010 12:27 AM |
How to write a macro to find a specified name in a list of data? | Jaffa | Excel | 1 | 10-23-2010 02:39 PM |
Macro to remove duplicates in Refrences list | HowardC | Word VBA | 0 | 05-20-2010 09:57 AM |
Show bookmarks | dempen | Word | 2 | 01-14-2010 11:47 PM |