Highlight All Bookmarks in Word Doc Via VBA - vba

I want to highlight all the bookmarks in my Word document. When I try to show the bookmarks, I only get the "I". And this code doesn't do anything.
Just like one of the commentators wrote, my bookmarks are 0 length. But even then how can I highlight say 2 spaces forward?
Sub BookMarks2Bold()
Dim bm As Bookmark
Dim tx As Range
Set tx = ActiveDocument.StoryRanges(wdMainTextStory)
For Each bm In tx.Bookmarks
bm.Range.HighlightColorIndex = wdYellow
Next
End Sub

If your bookmarks are zero range and you still want to highlight something in the document, you can extend the bookmark range, e.g. be the following character in the document:
Sub BookMarks2Bold()
Dim bm As Bookmark
Dim tx As Range
dim rng as Range
Set tx = ActiveDocument.StoryRanges(wdMainTextStory)
For Each bm In tx.Bookmarks
set rng = bm.Range
rng.MoveEnd wdCharacter ' extend by one character
' optionally, expand by one word
' rng.Expand wdWord
rng.HighlightColorIndex = wdYellow
Next
End Sub

Related

Word VBA: How to Fix FOR EACH loop to add bookmark to each sentence?

Within a Word docx: I'm trying to add a bookmark to each sentence. For example, at first sentence would be bookmark "bmarkpg01" and second sentence would be bookmark ""bmarkpg01ln01col01"". My code adds only one bookmark to first sentence and doesn't loop through to end of document.
I've tried a for each loop to attempt each sent in sentences and each bmark in bookmark.
Sub tryAddBmarkatSentence()
Dim myRange As Range
Set myRange = ActiveDocument.Content
Dim bmark As Bookmark
Application.ScreenUpdating = False
For Each MySent In ActiveDocument.Sentences
For Each bmark In ActiveDocument.Bookmarks
ActiveDocument.Bookmarks.Add Name:="pmark" & bmark.Range.Information(wdActiveEndAdjustedPageNumber), Range:=myRange 'bmark name would have added info of page, line, and col number. here as example is pagenumber.
Next
Next
End Sub
EXPECTED RESULT: Within entire document, each sentence has a corresponding bookmark and bookmark name ("bmarkpg01ln01col01", "bmarkpg01ln02col10", etc.)
ACTUAL RESULTS: only one bookmark is added to the first sentence of the document.
The following works for me, as far as the requirements in the question go.
Please remember to put Option Explicit at the top of a code page. This will force you to declare ("Dim") variables, but will also save time and trouble as it will prevent typos and warn you of other problems.
A Sentence in Word returns a Range object, so the code below delares MySent As Range. This provides the target Range for the Bookmarks.Add method.
If you won't be doing anything else with the bookmark, it's not strictly necessary to Set bkm = when adding the bookmark. I left it in since it is declared in the code in the question.
It's not necessary to loop the collection of bookmarks - espeicially since there aren't any - they're being added.
I've added some code for naming the bookmarks, as well.
Sub tryAddBmarkatSentence()
Dim doc As Word.Document
Dim MySent As Word.Range
Dim bmark As Bookmark
Application.ScreenUpdating = False
Set doc = ActiveDocument
For Each MySent In doc.Sentences
Set bmark = doc.Bookmarks.Add(Name:="bmark" & _
MySent.Information(wdActiveEndAdjustedPageNumber) & "_" &_
MySent.Information(wdFirstCharacterLineNumber) & "_" & _
MySent.Information(wdFirstCharacterColumnNumber), Range:=MySent)
'bmark name would have added info of page, line, and col number. here as example is pagenumber.
Next
End Sub
u can try like this
Sub tryAddBmarkatSentence()
Dim myRange As Range
Set myRange = ActiveDocument.Content
Dim bmark As Bookmark
Application.ScreenUpdating = False
For Each MySent In ActiveDocument.Sentences
ActiveDocument.Bookmarks.Add ... and the rest of the code.
//i dont know how you define witch bookmark is to asign to that sentence
Next
End Sub

Creating multiple Word paragraphs with Document.Paragraphs.Add()

I'm using a macro in Excel to add information to a Word document. I'm trying to add 10 lines to an existing Word document like this:
Sub AddParagraphs()
'Open Word
Dim wordApp As Word.Application
Set wordApp = CreateObject("Word.Application")
'Open
Dim doc As Word.document
Set doc = wordApp.Documents.Open("c:\temp\document.docx")
'Add 10 paragraphs
Dim idx As Integer
For idx = 1 To 10
Dim paragraph As Word.paragraph
Set paragraph = doc.Paragraphs.Add()
paragraph.Range.style = wdStyleHeading2
paragraph.Range.text = "Paragraph " & CStr(idx)
Next
doc.Save
doc.Close
wordApp.Quit
End Sub
I have an empty Word document at C:\temp\document.docs but after running the code there is only one line with the text "Paragraph 10". I was expecting 10 lines.
As far as I can tell the Paragraphs.Add() with no arguments should create a new paragraph. Perhaps I'm mistaken to believe that a new paragraph produces a new line? Is there another way to add 10 lines in a loop where each can have a specific (not the same) style?
The "paragraph" that you are adding does not have a paragraph mark at the end.
Change that line to
paragraph.Range.Text = "Paragraph " & CStr(idx) & vbCr
and that should fix your problem.
Actually, what's happening in the original code is that you're always replacing the content when you use
Doc.Paragraphs.Add
So there's only ever the one paragraph. There are various ways to get around this. One is to use InsertAfter, as has been mentioned in comments. (Note that if you're going to use this, the correct way to specify a new paragraph as part of a string is vbCr or Chr(13). Word can very easily misinterpret anything else!)
My personal preference is to work with a Range object that can be manipulated independently of the entire document. For example, it can be done like this:
Sub AddParagraphs()
'Open Word
Dim wordApp As Word.Application
Set wordApp = CreateObject("Word.Application")
'Open
Dim doc As Word.document
Set doc = wordApp.Documents.Open("c:\temp\document.docx")
Dim rng as Word.Range
Set rng = doc.Content
'Add 10 paragraphs
Dim idx As Integer
For idx = 1 To 10
Dim paragraph As Word.paragraph
'So that the next thing inserted follows instead of replaces
rng.Collapse wdCollapseEnd
Set paragraph = rng.Paragraphs.Add
paragraph.Range.style = wdStyleHeading2
paragraph.Range.text = "Paragraph " & CStr(idx)
Next
doc.Save
doc.Close
wordApp.Quit
End Sub
I had a similar problem. Adding doc.Range.InsertParagraphAfter fixed my problems. The following code should work for you:
Sub AddParagraphs()
'Open Word
Dim wordApp As Word.Application
Set wordApp = CreateObject("Word.Application")
'Open
Dim doc As Word.document
Set doc = wordApp.Documents.Open("c:\temp\document.docx")
'Add 10 paragraphs
Dim idx As Integer
For idx = 1 To 10
Dim paragraph As Word.paragraph
Set paragraph = doc.Paragraphs.Add()
paragraph.Range.style = wdStyleHeading2
paragraph.Range.text = "Paragraph "
doc.Range.InsertParagraphAfter
Next
doc.Save
doc.Close
wordApp.Quit
End Sub
The Paragraphs.Add method appends a new paragraph consisting of the paragraph mark only at the end of the document. Oddly enough, the return value is not the now last paragraph but the penultimate paragraph. You get a reference to the new last paragraph by the Next method of the paragraph object. You can then set the style and insert text with the paragraph.Range.InsertBefore method.
The critical part of your code must be like this
'Add 10 paragraphs
Dim idx As Integer
Dim paragraph As word.paragraph
For idx = 1 To 10
Set paragraph = doc.Paragraphs.Add.Next
paragraph.Range.style = word.WdBuiltinStyle.wdStyleHeading2
paragraph.Range.InsertBefore "Paragraph " & CStr(idx)
Next

Deleting Empty Paragraphs in Word Using VBA: Not All Empty Paragraphs Deleted

I wrote a macro to delete all the empty paragraphs in my document, but it exhibits weird behavior: If there are a number of empty paragraphs at the very end of the document, about half of them are deleted. Repeatedly running the macro gradually eliminates the empty paragraphs until only one empty paragraph remains. Even if there is a boundary condition so that I need a line of code to delete the last paragraph, but I still don't understand why only half of the empty paragraphs at the end are deleted. Can anyone explain why this is happening and how to correct this behavior? As an aside, I searched online and saw numerous posts about detecting paragraph markers (^p, ^13, and others, but only searching vbCr worked, which is another minor puzzle.)
Sub Delete_Empty__Paras_2() 'This macro looks for empty paragraphs and deletes them.
Dim original_num_of_paras_in_doc As Integer
Dim num_of_deleted_paras As Integer
original_num_of_paras_in_doc = ActiveDocument.Paragraphs.Count 'Count the number of paragraphs in the document to start
num_of_deleted_paras = 0 'In the beginning, no paragraphs have been deleted
Selection.HomeKey Unit:=wdStory 'Go to the beginning of the document.
For current_para_number = 1 To original_num_of_paras_in_doc 'Process each paragraph in the document, one by one.
If current_para_number + num_of_deleted_paras > original_num_of_paras_in_doc Then 'Stop processing paragraphs when the loop has processed every paragraph.
Exit For
Else 'If the system just deleted the 3rd paragraph of the document because
' it's empty, the next paragraph processed is the 3rd one again,
'so when we iterate the counter, we have to subtract the number of deleted paragraphs to account for this.
Set paraRange = ActiveDocument.Paragraphs(current_para_number - num_of_deleted_paras).Range
paratext = paraRange.Text
If paratext = vbCr Then 'Is the paragraph empty? (By the way, checking for vbCr is the only method that worked for checking for empty paras.)
paratext = "" 'Delete the paragraph.
ActiveDocument.Paragraphs(current_para_number - num_of_deleted_paras).Range.Text = paratext
num_of_deleted_paras = num_of_deleted_paras + 1 'Iterate the count of deleted paras.
End If
End If
Next current_para_number
End Sub
This code will delete all blank paragraphs...
Sub RemoveBlankParas()
Dim oDoc As Word.Document
Dim i As Long
Dim oRng As Range
Dim lParas As Long
Set oDoc = ActiveDocument
lParas = oDoc.Paragraphs.Count ' Total paragraph count
Set oRng = ActiveDocument.Range
For i = lParas To 1 Step -1
oRng.Select
lEnd = lEnd + oRng.Paragraphs.Count ' Keep track of how many processed
If Len(ActiveDocument.Paragraphs(i).Range.Text) = 1 Then
ActiveDocument.Paragraphs(i).Range.Delete
End If
Next i
Set para = Nothing
Set oDoc = Nothing
Exit Sub
End Sub
You can replace the paragraph marks:
ActiveDocument.Range.Find.Execute FindText:="^p^p", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Range.Find.Execute "^p^p", , , , , , , , , "^p", wdReplaceAll ' might be needed more than once

How to find and copy a table below a specified text

I have a word document with multiple text labels followed by its respective tables.
I want to find a text and then copy the table immediately below it so i can paste it in other document.
Sub EWT()
Dim para As Paragraph
Dim textA As String
For Each para In ActiveDocument.Paragraphs
If Not para.Range.Information(wdWithInTable) Then
textA = para.Range.Text
Debug.Print textA
'How to get the table just below this and copy it?
End If
Next
End Sub
The following is a general way of finding tables. In short, make a new range, assign the start of where the text leaves off, and the end is the end of the document. It'd be the first table. As an additional suggestion, avoid the Information function. One reason is it's slow.
Sub EWT()
Dim para As Paragraph
Dim textA As String
For Each para In ActiveDocument.Paragraphs
If Not para.Range.Information(wdWithInTable) Then
textA = para.Range.Text
para.Range.Select 'Debug only
Dim myRange As Range
Set myRange = ActiveDocument.Range
myRange.Start = para.Range.End
myRange.End = ActiveDocument.Range.End
Dim myTable As Table
Set myTable = myRange.Tables(1)
myTable.Select 'Debug only
Debug.Print textA
'How to get the table just below this and copy it?
End If
Next End Sub
Then again, it looks like you're wanting to find every table in the document, since your Find doesn't look for any specific text, just text. If that's the case, this is quicker:
Sub FindTables()
Dim myDocument As Document
Set myDocument = ActiveDocument
Dim myTable As Table
For Each myTable In myDocument.Tables
myTable.Select
Next End Sub

How can I update MS Word fields based on contents of other fields within the document?

I am trying to find a way to lookup and replace contents within an MS Word Doc based on certain content within the same document. I have system generated Word Documents that are one page each in length, but the number of pages can vary from one to 100 (or more). Each document is formatted exactly the same. One phrase with each page of the document (such as "Type of Charge" may or may not vary from one page to the next. I need to be able to insert the actual amount of the charge on each page based on the type of charge reflected on that given page.
I was taking the approach of setting bookmark ranges that would be used to search for the phrase, and then setting a bookmark that would indicate where to insert the value. Here is what I have so far:
Sub bmAmtDue()
'
' bmAmtDue
'
'
Dim rng As Range
Dim iBookmarkSuffix As Integer
Dim strBookMarkPrefix
strBookMarkPrefix = "BM"
Set rng = ActiveDocument.Range
With rng.Find
.Text = "Please see fee chart, with additional requirements, on reverse side"
Do While .Execute
rng.Text = "" 'clear the "XXX" (optional)
iBookmarkSuffix = iBookmarkSuffix + 1
ActiveDocument.Bookmarks.Add strBookMarkPrefix & iBookmarkSuffix, rng
Loop
End With
End Sub
Sub bmStartPermitType()
'
' bmStartPermitType
'
'
Dim rng2 As Range
Dim iBookmarkSuffix As Integer
Dim strBookMarkPrefix
strBookMarkPrefix = "BMStartPermitType"
Set rng = ActiveDocument.Range
With rng.Find
.Text = "Type:"
Do While .Execute
iBookmarkSuffix = iBookmarkSuffix + 1
ActiveDocument.Bookmarks.Add strBookMarkPrefix & iBookmarkSuffix, rng
Loop
End With
End Sub
Sub bmEndPermitType()
'
' bmEndPermitType
'
'
Dim rng2 As Range
Dim iBookmarkSuffix As Integer
Dim strBookMarkPrefix
strBookMarkPrefix = "BMEndPermitType"
Set rng = ActiveDocument.Range
With rng.Find
.Text = "Amount due:"
Do While .Execute
iBookmarkSuffix = iBookmarkSuffix + 1
ActiveDocument.Bookmarks.Add strBookMarkPrefix & iBookmarkSuffix, rng
Loop
End With
End Sub
Bookmarks are OK, but might be "too flexible" - They can even start in the middle of a table cell and end in a the middle of another paragraph. I suggest you to try doing it with Content Controls - their appearance might also be more suitable for your scenario. Check this link.
If you can write a simple .NET application, there is mail merge toolkit that will make your task much more easy. It will allow you to create word document that will act as a template (it also uses Content Controls for tagging) which you will be able to populate with data from your .NET application. And it demands only couple of lines of code to write.