Iam just starting with using the word macros. I have a problem to identify all cross references and hyperlinks in the word document. Iam using a macro to solve this problem
The macro i have written is.
For Each fld In ActiveDocument.Fields
If fld.Type = wdFieldRef Or fld.Type = wdFieldHyperlink Then
fld.Select
For Each ch In Selection.Characters
ch.HighlightColorIndex = wdYellow
Next
End If
Next
This is the macro I have written, it is working as expected but it is too slow that i cannot use it.
There must be an efficient way to solve this problem. If yes please let me know-how.Any reference to sites so that I can refer would also be ok.
Thanks
Disable screen updating and avoid selecting anything wherever possible. For example:
Sub Demo()
Application.ScreenUpdating = False
Dim Fld As Field
For Each Fld In ActiveDocument.Fields
With Fld
Select Case .Type
Case wdFieldRef, wdFieldPageRef, wdFieldHyperlink
.Result.HighlightColorIndex = wdYellow
End Select
End With
Next
Application.ScreenUpdating = True
End Sub
Related
I'm facing a challenging request I need to solve using a VBA Macro in Word.
The document is a template that will grab some data in a DB upon generation. It contains multiple tables but I don't know how many and how many data will be in each table.
It looks like this:
Sample initial state
The requirement is to be able to detect the strings that are not followed by a table and delete them.
Said differently when a string is followed by the table, it's all good. When a string is followed by another string, it should be deleted.
The different strings are known, I'm guessing this would help.
After the macro run, my previous sample should look like this:
Sample expected result
I know it looks bit harsh but I don't even know where to start :(
I've looked at macro searching for a text but I wasn't able to find something like
IF stringA is followed by a table then do nothing if not then delete.
Any help of the community would be very much appreciated!
Thanks
Julien
This should get you started:
Sub FindAndDelete()
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "Text to find"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
.Next(wdParagraph).Delete
End If
Loop
End With
End Sub
Thank you so much!
I was able to make it work by slightly modifying it as the proposed code was deleting the string followed by the table:
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "This is my table C"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
.Delete
End If
Loop
End With
my last step is to make the macro run only for a specific part of the document. I guess I need to work on the range. I'll give a try and post the result here.
Again thank you for helping pure newbies!
So I had it working using the below code. I slightly modify the "while" loop so that it deletes the entire row rahter than just the word
Sub HeaderDelete()
'
' HeaderDelete Macro
'
Dim rng As Range
Set rng = ActiveDocument.Content
With rng
With .Find
.ClearFormatting
.Text = "This is my table A"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
Selection.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
With .Find
.ClearFormatting
.Text = "This is my table B"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
SelectionS.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
With .Find
.ClearFormatting
.Text = "This is my table C"
End With
Do While .Find.Execute
If .Next(wdParagraph).Tables.Count = 0 Then
Selection.HomeKey wdLine
SelectionS.EndKey wdLine, wdExtend
Selection.Delete
End If
Loop
End With
End Sub
The challenge is I have 50+ "this is my table X" and they may possibly change overtime...
I tried to find a solution which wouldn't be used on the ".Find" but more on "if there is a row not followed by a table then delete" but I wasn't successful so far.
On a side note I wanted to remove the table borders of all my tables and I found the below which works great!
Dim doc As Document
Dim tbl As Table
Set doc = ActiveDocument
For Each tbl In doc.Tables
With tbl.Borders
.InsideLineStyle = wdLineStyleNone
.OutsideLineStyle = wdLineStyleNone
End With
Next
Again, thanks a lot for helping VBA newbies!
Sorry for the fundamental question but I am a LONGtime Access VBA developer who is getting my butt kicked by Word.
I am building a solution for someone who uses a Legal Case Management System with a specific numbering scheme (aaa-aaa-##-##-###). I need to search a document for hyphens and then grab the whole paragraph where a hyphen is found. I then need to send the text from that paragraph to a separate function which parses out the file number from the paragraph (this function already works).
If that function is successful, it returns the File Number, otherwise it returns "NOT FOUND". So, I need to:
Find all hyphens
Capture the paragraph with a hyphen
Pass that text to the function
GO TO THE NEXT HYPHEN IF function returns "NOT FOUND"
I have tried dozens of options without success. I typically get stuck in an infinite loop (and do not seem to move forward) or I get to the end of the process with a false failure.
I do not know how to move to the NEXT occurrence of a hyphen and repeat the process. I also do not know how to run the process to the end of the document or stop at the end (without starting all over - because the hyphens REMAIN since this is NOT a replace process).
I have tried so many different versions, but I included one below.
Thanks for any guidance. I do appreciate it.
DGP
Public Sub TestFind77() '
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Text = "-"
.Execute Forward:=True
Do While .Found = True
.Parent.Expand Unit:=wdParagraph
Dim strWTF As String
strWTF = .Parent
'MsgBox strWTF
strResult = fnGetFileNumberFromString(strWTF) ' This works
If strResult <> "NOT FOUND" Then
GoTo success
End If
.Execute Forward:=True
Loop
End With
success:
MsgBox strResult
End Sub
I understand... Good start and you're missing only tiny pieces.
One thing you need is Word's Range object. Best to use that with Find - unlike Selection you can work with multiple Ranges in your code.
Sometimes, when working with Find it's necessary to refer back to the original Range (the entire document, in your case). That doesn't appear to be the case, here, but I've built it in, anyway, on general principle - so you have it if it turns out you need it.
I've found it more reliable to save the result of Find.Execute in a boolean variable, rather than relying on .Found, so I've put that in, as well.
You can pick up the paragraph in which the Range is located using Range.Paragraphs(1). I tried to stick to what you have, but if you want to tighten up your code even more, you could do this as long as you don't need the paragraph for anything else:
strWTF = rngSearch.Paragraphs(1).Range.Text
Good luck!
Public Sub TestFind77()
Dim rngDoc as Word.Range
Dim rngSearch as Word.Range
Dim bFound as boolean
Dim para as Word.Paragraph
Set rngDoc = ActiveDocument.Range
Set rngSearch = rngDoc.Duplicate
With rngSearch.Find
.ClearFormatting
.Text = "-"
bFound = .Execute(Forward:=True)
Do While bFound = True
Set para = rngSearch.Paragraphs(1)
Dim strWTF As String
strWTF = para.Range.Text '???.Parent
'MsgBox strWTF
strResult = fnGetFileNumberFromString(strWTF) ' This works
If strResult <> "NOT FOUND" Then
GoTo success
End If
rngSearch.Collapse wdCollapseEnd 'search from after the found to the end of the doc
bFound = .Execute(Forward:=True)
Loop
End With
success:
MsgBox strResult
End Sub
Thanks Cindy,
I am still not sure that I understand the Word Object Model well enough to understand why...but your answer got it to work.
I did incorporate your suggestion re
strWTF = rngSearch.Paragraphs(1).Range.Text
Here is the final code, including that input:
Public Sub TestFind99()
Dim rngDoc As Word.Range
Dim rngSearch As Word.Range
Dim bFound As Boolean
Dim strWTF As String
Set rngDoc = ActiveDocument.Range
Set rngSearch = rngDoc.Duplicate
With rngSearch.Find
.ClearFormatting
.Text = "-"
bFound = .Execute(Forward:=True)
Do While bFound = True
strWTF = rngSearch.Paragraphs(1).Range.Text
strResult = fnGetFileNumberFromString(strWTF) ' This works
If strResult <> "NOT FOUND" Then
GoTo success
End If
rngSearch.Collapse wdCollapseEnd 'search from after the found to the end of the doc
bFound = .Execute(Forward:=True)
Loop
End With
success:
MsgBox strResult
End Sub
I'm new to VBA and would greatly appreciate some help on a problem.
I have long Word documents where I need to apply standard comments to the same set of keywords, but only in selected sections of the document. The following macro worked to find a keyword and apply a comment (from question here https://superuser.com/questions/547710/macro-to-insert-comment-bubbles-in-microsoft-word):
Sub label_items()
'
' label_items Macro
'
'
Do While Selection.Find.Execute("keyword1") = True
ActiveDocument.Comments.Add range:=Selection.range, Text:="comment for keyword 1"
Loop
End Sub
The two modifications are:
1) only apply the comments to user selected text, not the whole document. I tried a "With Selection.Range.Find" approach but I don't think comments can be added this way (??)
2) repeat this for 20+ keywords in the selected text. The keywords aren't totally standard and have names like P_1HAI10, P_1HAI20, P_2HAI60, P_HFS10, etc.
EDIT: I have tried to combine code from similar questions ( Word VBA: finding a set of words and inserting predefined comments and Word macro, storing the current selection (VBA)) but my current attempt (below) only runs for the first keyword and comment and runs over the entire document, not just the text I have highlighted/selected.
Sub label_items()
'
' label_items Macro
'
Dim selbkup As range
Set selbkup = ActiveDocument.range(Selection.range.Start, Selection.range.End)
Set range = selbkup
Do While range.Find.Execute("keyword 1") = True
ActiveDocument.Comments.Add range, "comment for keyword 1"
Loop
Set range = selbkup
Do While range.Find.Execute("keyword 2") = True
ActiveDocument.Comments.Add range, "comment for keyword 2"
Loop
'I would repeat this process for all of my keywords
End Sub
I've combed through previous questions and the Office Dev Center and am stuck. Any help/guidance is greatly appreciated!
It's a matter of adding a loop and a means of Finding the next keyword you're looking for. There are a few suggestions in the code example below, so please adjust it as necessary to fit your requirements.
Option Explicit
Sub label_items()
Dim myDoc As Document
Dim targetRange As Range
Set myDoc = ActiveDocument
Set targetRange = Selection.Range
'--- drop a bookmark to return the cursor to it's original location
Const RETURN_BM = "OrigCursorLoc"
myDoc.Bookmarks.Add Name:=RETURN_BM, Range:=Selection.Range
'--- if nothing is selected, then search the whole document
If Selection.Start = Selection.End Then
Selection.Start = 0
targetRange.Start = 0
targetRange.End = myDoc.Range.End
End If
'--- build list of keywords to search
Dim keywords() As String
keywords = Split("SMS,HTTP,SMTP", ",", , vbTextCompare)
'--- search for all keywords within the user selected range
Dim i As Long
For i = 0 To UBound(keywords)
'--- set the cursor back to the beginning of the
' originally selected range
Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM
Do
With Selection.Find
.Forward = True
.Wrap = wdFindStop
.Text = keywords(i)
.Execute
If .Found Then
If (Selection.Start < targetRange.End) Then
Selection.Comments.Add Selection.Range, _
Text:="Found the " & keywords(i) & " keyword"
Else
Exit Do
End If
Else
Exit Do
End If
End With
Loop
Next i
'--- set the cursor back to the beginning of the
' originally selected range
Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM
End Sub
I need to automate the insertion of comments into a word document: searching for a predefined set of words (sometimes word strings, and all non case-sensitive) each to which I add a predefined comment.
There are two word sets, with two goals:
Wordset 1: identical comment for each located word
Wordset 2: individual comments (I suggest new text based on the word identified)
I have been semi-automating this with a code that IDs all identified words and highlights them, helping me through the process (but I still need to enter all the comments manually - and I've also been able to enter comments - but only on one word at a time.) As my VBA skills are limited, my attempts to compile a robust macro from bits of other code with similar purposes has unfortunately led me nowhere.
Below are the bits of code I've been using.
Sub HighlightWordList()
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("word1", "word2", "word3")
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow
Loop
End With
Next
End Sub
The following code has been able to get me to insert bubbles directly
Sub CommentBubble()
'
'
Dim range As range
Set range = ActiveDocument.Content
Do While range.Find.Execute("Word x") = True
ActiveDocument.Comments.Add range, "my comment to enter in the bubble"
Loop
End Sub
I've tried to have the process repeat itself by doing as shown below, but for reasons I'm certain are evident to many of you (and completely unknown to me) - this strategy has failed, working for "word x" but failing to function for all subsequent words:
Sub CommentBubble()
'
'
Dim range As range
Set range = ActiveDocument.Content
Do While range.Find.Execute("Word x") = True
ActiveDocument.Comments.Add range, "my 1st comment to enter in the bubble"
Loop
Do While range.Find.Execute("Word y") = True
ActiveDocument.Comments.Add range, "my 2nd comment to enter in the bubble"
Loop
End Sub
I've mixed and matched bits of these codes to no avail. Any ideas to help me with either wordset?
Thanks for everyone's help!
Best regards
Benoit, you're almost there! All you need to do is redefine the range object after your first loop (because it would have been exhausted at that point). Like so:
Sub CommentBubble()
Dim rng As range
Set rng = ActiveDocument.Content
Do While rng.Find.Execute("Word x") = True
ActiveDocument.Comments.Add rng, "my 1st comment to enter in the bubble"
Loop
Set rng = ActiveDocument.Content ' <---------------Add This.
Do While rng.Find.Execute("Word y") = True
ActiveDocument.Comments.Add rng, "my 2nd comment to enter in the bubble"
Loop
End Sub
That should do the trick for you (it works on my end). If not, let me know.
I have a script that looks for some text, inputted by the user. The idea is to look through a document for this text, and when it's found, select the paragraph and ask the user if they want to add this paragraph to an Index.
For some reason, I can't get the script to move past the first selected paragraph. When I run it, and click "Yes" in the UserForm (equivalent of myForm.Tag = 2), it adds to the index, but then when the .Find looks for the next instance of the text, it selects the paragraph I just had highlighted. ...it doesn't continue.
Here's the code:
Sub find_Definitions()
Dim defText As String, findText$
Dim oRng As Word.Range, rng As Word.Range
Dim myForm As frmAddDefinition
Set myForm = New frmAddDefinition
Dim addDefinition$, expandParagraph&
' expandParagraph = 1
Set oRng = ActiveDocument.Range
findText = InputBox("What text would you like to search for?")
With oRng.Find
.Text = findText
While .Execute
Set rng = oRng.Paragraphs(1).Range
rng.Select
defText = oRng.Paragraphs(1).Range
myForm.Show
Select Case myForm.Tag
Case 0 ' Expand the paragraph selection
Do While CLng(expandParagraph) < 1
expandParagraph = InputBox("How many paragraphs to extend selection?")
If expandParagraph = 0 Then Exit Do
Loop
rng.MoveEnd unit:=wdParagraph, Count:=expandParagraph
rng.Select
defText = rng
ActiveDocument.Indexes.MarkEntry Range:=rng, entry:=defText, entryautotext:=defText
Case 1 ' No, do not add to the index
' do nothing
Case 2 ' Yes, add to index
ActiveDocument.Indexes.MarkEntry Range:=rng, entry:=defText, entryautotext:=defText
Case 3 ' Cancel, exit the sub
MsgBox ("Exiting macro")
GoTo lbl_Exit
End Select
Wend
End With
lbl_Exit:
Unload myForm
Set myForm = Nothing
End Sub
(FWIW, I'm pretty new to Word VBA, but very familiar with Excel VBA). Thanks for any ideas.
Note if I click "No" (equivalent of myForm.Tag = 1), then it does move on to the next instance. Hmm.
Try adding rng.Collapse wdCollapseEnd before the "Case 1" line.
Explanation: When you use Find, it executes on the given Range or Selection.
If it's successful, that Range/Selection changes to include the "found" term. In this case, you in addition change the assignment again (expanding to include the paragraph).
When your code loops the current assignment to "Range" is used - in this case, Find looks only at the selected paragraph Range. So you need to reset the Range in order to have Find continue.
To be absolutely accurate, after Collapse you could also add:
rng.End = ActiveDocument.Content.End
Note: it's more correct to use ActiveDocument.Content than ActiveDocument.Range. ActiveDocument.Range is actually a method for creating a new Range by specifying the Start and End points, while ActiveDocument.Content returns the entire main story (body) of the document as a Range object. VBA doesn't care, it defaults the method to return the main story. Other programming languages (.NET, especially C#) don't work as intuitively with Word's object model, however. So it's a good habit to use what "always" works :-)