I trying to replace or search and add hyperlink to specyfy sentence in Word document. I try using this codes. Anyway code is changing only first finding word, not all in document:
Dim r As Word.Range
r = Globals.ThisAddIn.Application.ActiveDocument.Content
With r.Find
.ClearFormatting()
.Text = ("MyWordA MyWordB")
.MatchWholeWord = True
.Forward = True
.Execute()
'If .Found = True Then r.Hyperlinks.Add(r, "http:\\www.whatever", , "Displayed text")
Do While .Execute(Forward:=True) = True
r.Hyperlinks.Add(r, "http:\\www.whatever", , "Displayed text")
'r.Font.ColorIndex = Word.WdColorIndex.wdBlue 'works for all(?)
Loop
End With
Eaven when I want to find only single word in loop for, then code find first one:
doc = Globals.ThisAddIn.Application.ActiveDocument
Dim r As Word.Range = doc.Range
Dim ww As Word.Range
For Each ww In r.Words
If ww.Text = "MyWord" Then _
ww.Hyperlinks.Add(ww, "http:\\www.whatever", , "Displayed text")
Next
Anyone could tell me how I can search all text to replace/add hyperlinks to all text I was looking for?
The problem is that you keep finding the same text over and over again. Within your loop, after adding the hyperlink, you need to move the range after the added hyperlink. The simplest way to do this is to collapse the range by calling
r.Collapse(WdCollapseDirection.wdCollapseEnd)
To troubleshoot issues like this it is helpful to select the current range so that you can see what is going on.
Do While .Execute(Forward:=True) = True
' select range for troubleshooting
r.Select()
r.Hyperlinks.Add(r, "http:\\www.whatever", , "Displayed text")
' move the range after the link
r.Collapse(WdCollapseDirection.wdCollapseEnd)
Loop
Related
I'd like to find several strings within Word document and for each string found, I like to print (debug.print for example) the whole row content where the string is found, not the paragraph.
How can I do this? Thanks
Sub FindStrings
Dim StringsArr (1 to 3)
StringsArr = Array("string1","string2","string3")
For i=1 to 3
With
Selection.Find
.ClearFormatting
.Text = Strings(i)
Debug.Print CurrentRow 'here I need help
End With
Next
End Sub
The term Row in Word is used only in the context of a table. I assume the term you mean is Line, as in a line of text.
The Word object model has no concept of "line" (or "page") due to the dynamic layout algorithm: anything the user does, even changing the printer, could change where a line or a page breaks over. Since these things are dynamic, there's no object.
The only context where "line" can be used is in connection with a Selection. For example, it's possible to extend a Selection to the start and/or end of a line. Incorporating this into the code in the question it would look something like:
Sub FindStrings()
Dim StringsArr As Variant
Dim bFound As Boolean
Dim rng As Word.Range
Set rng = ActiveDocument.content
StringsArr = Array("string1", "string2", "string3")
For i = LBound(StringsArr) To UBound(StringsArr)
With rng.Find
.ClearFormatting
.Text = StringsArr(i)
.Wrap = wdFindStop
bFound = .Execute
'extend the selection to the start and end of the current line
Do While bFound
rng.Select
Selection.MoveStart wdLine, -1
Selection.MoveEnd wdLine, 1
Debug.Print Selection.Text
rng.Collapse wdCollapseEnd
bFound = .Execute
Loop
End With
Set rng = ActiveDocument.content
Next
End Sub
Notes
Since it's easier to control when having to loop numerous times, a Range object is used as the basic search object, rather than Selection. The found Range is only selected for the purpose of getting the entire line as these "Move" methods for lines only work on a Selection.
Before the loop can continue, the Range (or, if we were working with a selection, the selection) needs to be "collapsed" so that the code does not search and find the same instance of the search term, again. (This is also the reason for Wrap = wdFindStop).
I have several Word-Files containing old-style non-clickable UTF8-character checkboxes () and I want to replace them with real, clickable Checkboxes. They should be unchecked for and checked for another specified UTF8-character (which I do not know the number of right now).
I tried search and replace and copying from macros I've found online. I'm not a word user and this is a one-time-task, so I sadly do not have the time to learn VBA well enough to write such a thing as a macro.
I've found this online, but in the Macros-Window, I cannot even copy to "string to be searched".
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "string to be searched"
.Replacement.Text = "string to be replaced"
.Wrap = wdFindContinue
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = False
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
For Searching UTF=8 Character you have to search Unicodes like
U+2610 decimal ☐ Unchecked Checkbox
U+2611 decimal ☑ Checked Checkbox
U+2612 decimal ☒ Crossed Checkbox
Other like Unicode characters may also be explored for exactly what is it in your case. I tested with U+2610 decimal ☐ Unchecked Checkbox.
For replacement with FormField type of ComboBox I successfully used the code below
Sub TestFormFieldCB()
Dim Rng As Range, cb As FormField
ActiveDocument.Content.Select
With Selection.Find
.Text = ChrW(9744)
Do While .Execute
Set Rng = Selection.Range
ht = Rng.Font.SizeBi
Rng.Delete
Set cb = Rng.FormFields.Add(Rng, wdFieldFormCheckBox)
cb.CheckBox.Size = ht
Loop
End With
'ActiveDocument.Protect wdAllowOnlyFormFields
End Sub
The disadvantage of this type ComboBox is document is to be protected for the ComboBox to be clickable.
As Second option I tried with ActiveX Type ComboBox. It is easilyclickable even in unprotected mode but difficult to align and size with the text in the line. Also Somehow i could not use the same find Loop as in the above code and had to work around with some other way.
The final tested code is
Sub testActiveXCB()
Dim Rng As Range, cb As InlineShape, Fnd As Boolean
ActiveDocument.Content.Select
With Selection.Find
.Text = ChrW(9744)
.Execute
Do While Selection.Find.Found
Set Rng = Selection.Range
ht = Rng.Font.SizeBi
Rng.Delete
Set cb = Rng.InlineShapes.AddOLEControl(ClassType:="Forms.CheckBox.1")
Debug.Print cb.OLEFormat.Object.Name & "-" & cb.Height
cb.Width = cb.Height
cb.Width = ht
cb.OLEFormat.Object.Caption = ""
cb.OLEFormat.Object.PicturePosition = 2
'Use next Line when replacing Checked Unicode Char mat be U+2611 or U+2612
'cb.OLEFormat.Object.Value = True
ActiveDocument.Content.Select
Selection.Find.Execute
Loop
End With
End Sub
(All tests are carried out in Word 2007 only)
I request more answers and eager to learn from Word VBA experts regarding
Why the ActiveX Combo Box could not be inserted with the simple Find loop used in case of FormField type Combo Box?
How to effectively align Active X Combo Box with the text Line?
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 Word document full of newspaper articles. Each newspaper article is preceded by the article title and the string "Length:", which is followed by the number of words in the article (i.e. "Length: 1500 words"). I simply need an Excel Macro that will comb the Word document and extract the length value for each article - placing these values in an Excel column.
Through my Googling, I found this: Extract Data from Word Document to an Excel SpreadSheet
This is almost what I need, but it only returns the first article length value found by the search. How do I modify the code to find every article length value, return these values to an Excel column and then terminate?
The code to which you link is not particularly robust. I've extracted the assignment to the cell in Excel (ExR(1, 1) = WDR ' place at Excel cursor) and built more robust Word code around it.
The code uses the Word Range object instead of Selection. This is more efficient, more predictable and the screen won't jump around. The Find uses a wildcard search for the specific text, plus the digits between "Length " and " words". Since a successful Find includes the found Range, all that's necessary is to assign the Range's Text to the cell in Excel.
The Find plus assignment is built into a LOOP, which runs as long as Find.Execute is successful. For the cell assignment in Excel a COUNTER is incremented in each loop so you don't need to hard-code the target cell indices.
Dim strFind As String
Dim rngFind As word.Range 'or As Object if you don't set a Reference to the Word object library
Dim bFound As Boolean
Dim iCellCounter As Long
strFind = "Length: [0-9]{1;} words"
bFound = False
iCellCounter = 1
Set rngFind = WApp.ActiveDocument.Content
With rngFind.Find
.ClearAllFuzzyOptions
.ClearFormatting
.ClearHitHighlight
.Format = False
.MatchWildcards = True
.Text = strFind
.wrap = wdFindStop '0 if you don't use a Reference to the Word object library
Do
bFound = .Execute
If bFound Then
ExR(1, iCellCounter) = rngFind.Text
iCellCounter = iCellCounter + 1
End If
Loop While bFound
End With