Is it possible to use the find and replace feature to find a word and attach a hyperlink to it? Below is an example that just replaces the text, any suggestions on how to format this to make it work. I'm trying to make it so AMD41 would be hyperlinked to example.com. What would the right code look like?
Set myRange = ActiveDocument.Content
myRange.Find.Execute FindText:="AMD41", Forward:=True
If myRange.Find.Found = True Then myRange.Text = "www.example.com"
Thanks in advance
Try this:
Option Explicit
Sub TextFindAndHyperlink()
Dim SearchRange As Range
Dim SearchText As String
Dim WebAddress As String
Set SearchRange = ActiveDocument.Range
SearchText = "AMD41"
WebAddress = "http://www.example.com/"
With SearchRange.Find
Do While .Execute(SearchText, , True, , , , True) = True
With SearchRange
.Hyperlinks.Add SearchRange, WebAddress
End With
SearchRange.Collapse wdCollapseEnd
Loop
End With
End Sub
Related
I am trying to create a macro that finds all text formulas and replaces it with OMath formulas.
I create a text, where all formulas are surrounded with special tags (in my case its word "formula"). Then I find all cases with regex and create variable that contains found formula. Then I give this variable to find method to create range, which I then modify.
Some formulas contain special characters (in my case its caret (^), which is used to create power) and find method doesn't select them.
How can I ignore special characters in variable that I give to find method?
Macro that I created:
Dim regexObject As Object
Set regexObject = CreateObject("VBScript.RegExp")
Dim matches As Object
Dim objEq As OMath
Dim objRange As Range
Dim match As Object
regexObject.Pattern = "formula(.*?)formula"
regexObject.MultiLine = True
Selection.WholeStory
While regexObject.test(Selection.Text)
Set matches = regexObject.Execute(Selection.Text)
For Each match In matches
MsgBox match
With Selection.Find
.Text = match
.MatchWildcards = False
.Execute
Set objRange = Selection.Range
objRange.Text = Mid(match, 8, Len(match) - 14)
Set objRange = Selection.OMaths.Add(objRange)
Set objEq = objRange.OMaths(1)
objEq.BuildUp
End With
Selection.WholeStory
Next
Wend
Sample Text:
formulaΨ=1,67∙0,72∙0,9∙1=1,09.formula
formulac_c=0,9formula
formulaE_q=Ψ WV_n^2/2,formula
formulac_m, c_e, c_c, c_sformula
For example:
Sub FindFormulaeCreateOMath()
Dim objEq As OMath
Dim findRange As Range
Dim eqRange As Range
Set findRange = ActiveDocument.Content
With findRange
With .Find
.Text = "formula*formula"
.MatchWildcards = True
End With
Do While .Find.Execute
.Text = Mid(.Text, 8, Len(.Text) - 14)
Set eqRange = findRange.OMaths.Add(.Duplicate)
Set objEq = eqRange.OMaths(1)
objEq.BuildUp
.Collapse wdCollapseEnd
Loop
End With
End Sub
I have a macro in Word that searches a document, and then does things when found.
I would like to check if the Found text is in a table of contents, but it doesn't seem to be liking how I have the code:
Sub test()
Dim myDoc As Word.Document
Dim oRng As Word.Range, rng As Word.Range, rngXE As Word.Range
Dim addDefinition$, editedDefinition$ ',findText$
Dim rngEdited
Dim bFound As Boolean
Dim findText() As Variant
Dim y&
Set myDoc = ActiveDocument
bFound = True
Call Clear_Index
findText = Array("whatever", "whatever:", "Whatever:")
For y = LBound(findText) To UBound(findText)
'Loop through the document
Set oRng = myDoc.Content
Set rngXE = oRng.Duplicate
With oRng.Find
.ClearFormatting
.ClearAllFuzzyOptions
.Text = findText(y)
.MatchCase = False
.Wrap = wdFindStop
End With 'orng.find
Do While bFound
bFound = oRng.Find.Execute
If bFound Then
Set rngXE = oRng.Paragraphs(1).Range.Duplicate
rngXE.Select
'
' THIS IS WHERE I NEED HELP :(
If rngXE.Fields.Type = wdFieldTOC Then ' This doesn't work.
MsgBox (" In a TOC!")
End If
End If
End Sub
It throws
Compile Error: Method or data member not found
I've seen loops of
For each fld in myDoc.Fields
If fld.Type = wbFieldTOC Then
'Do something
end if
next fld
Which work - I'm just having a hard time understanding to find specific text's field.
The InRange method is useful for discovering if one range is located within another range. Since there is a TableOfContents collection for the Document object, it's simple enough to get that range and test whether some other ange (even Selection.Range) is within it.
The following snippet assumes the document has a TOC and that you're interested in the first TOC. If your situation is otherwise, you need to do some checking to make sure the reference is to the correct TOC:
oRng.InRange(ActiveDocument.TablesOfContents(1).Range)
I have a MS Excel worksheet with custom script. Part of this script is supposed to edit information in a MS Word document.
The thing that needs to be edited is text stored in a table cell in the Word document. I managed to edit the text it self, but I need to set part of the text to bold.
How can I do this?
Here is an example. Say I need to enter "123456789" in the table cell(1,1) and set the first characters "12345" to bold. Like this:
From Excel. Here is what I tried:
Dim SavePath as string
SavePath = "... path ..."
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(SavePath)
objWord.Visible = True
objDoc.Tables(1).Cell(1, 1).Range.Text = "123456789"
'So far, so good. The next part (how to set part of text to bold) is what I can't figure out. This does not work:
With objDoc.Tables(1).Cell(1, 1).Range(Start:=0, End:=5)
.Content.Font.Bold = True
End With
I know I can set a whole single cell to bold with this:
objDoc.Tables(1).Cell(ThisRow, ThisCol).Range.Bold = True
But can I address specific characters within a cell?
Can anyone help me?
Try this
Tried and tested in Windows 7 pr. 64, Word 2010 32.
Sub test()
Set objDoc = ActiveDocument
objDoc.Tables(1).Cell(1, 1).Range.Text = "123456789"
Set myrange = objDoc.Tables(1).Cell(1, 1).Range.Paragraphs(1).Range
MsgBox myrange.Text
lStartPos = myrange.Characters(1).Start
lEndPos = myrange.Characters(5).End
Set myrange = objDoc.Range(lStartPos, lEndPos)
myrange.Font.Bold = True
End Sub
you should use this.
Sub test()
Dim SavePath As String
SavePath = "... path ..."
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(SavePath)
objWord.Visible = True
objDoc.Tables(1).Cell(1, 1).Range.Text = "123456789"
Set myrange = objDoc.Tables(1).Cell(1, 1).Range.Paragraphs(1).Range
MsgBox myrange.Text
lStartPos = myrange.Characters(1).Start
lEndPos = myrange.Characters(5).End
Set myrange = objDoc.Range(lStartPos, lEndPos)
myrange.Font.Bold = True
End Sub
This is a silly question, but can't figure it out.
Straight from the Microsoft Site:
This example finds every instance of the word "Start" in the active document and replaces it with "End." The find operation ignores formatting but matches the case of the text to find ("Start").
Set myRange = ActiveDocument.Range(Start:=0, End:=0)
With myRange.Find
.ClearFormatting
.Text = "Start"
With .Replacement
.ClearFormatting
.Text = "End"
End With
.Execute Replace:=wdReplaceAll, _
Format:=True, MatchCase:=True, _
MatchWholeWord:=True
End With
I need to know how to make it so it only finds the next instance of Start and replace it with End. This will leave all other Ends intact throughout the document.
You should use wdReplaceOne in place of wdReplaceAll.
You should be able to adapt this:
Sub Tester()
Const FIND_WHAT as String = "Start"
Const REPLACE_WITH as String = "End"
Const REPLACE_WHICH As Long = 4 'which instance to replace?
Dim rng As Range, i As Long
i = 0
Set rng = ActiveDocument.Content
With rng.Find
.ClearFormatting
.Text = FIND_WHAT
Do While .Execute(Format:=True, MatchCase:=True, _
MatchWholeWord:=True)
i = i + 1
If i = REPLACE_WHICH Then
'Note - "rng" is now redefined as the found range
' This happens every time Execute returns True
rng.Text = REPLACE_WITH
Exit Do
End If
Loop
End With
End Sub
This discussion has some useful suggestions: Replace only last occurrence of match in a string in VBA. In brief, it's a case of looping through your search string from start until the first instance of the search argument is located and replacing just that.
I've a word document with some text. At some paragraphs I've words that I want to add the hyperlink to. Here's an example:
The book "When the sun goes up", ABC-1212321-DEF, have been released today.......
The "ABC-1212321-DEF" should be found and apply a hyperlink as follows: http://google.com/ABC-sometext-1212321-anothertext-DEF
All the strings in the document starts with "ABC-" and ends with "-DEF".
Thanks in advanced.
EDIT:
This is what I've got this far:
Sub InsertLinks()
Dim r As Range
Dim SearchString As String
Set r = ActiveDocument.Range
SearchString = "ABC-"
With r.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=True) = True
ActiveDocument.Hyperlinks.Add Anchor:=r, _
Address:=Replace(r.Text, " ", ""), _
SubAddress:="", ScreenTip:="", TextToDisplay:=r.Text
With r
.End = r.Hyperlinks(1).Range.End
.Collapse 0
End With
Loop
End With
End Sub
This now detects ABC- and add some random link. But need to get the number between ABC- and -DEF. The length is not the same.
SOLUTION
This is the code that solved my problem:
Sub InsertLinksTB()
Dim Rng As Range
Dim SearchString As String
Dim EndString As String
Dim Id As String
Dim Link As String
Set Rng = ActiveDocument.Range
SearchString = "ABC-"
EndString = "-DEF"
With Rng.Find
.MatchWildcards = True
Do While .Execute(findText:=SearchString, Forward:=False) = True
Rng.MoveStartUntil ("ABC-")
Rng.MoveEndUntil (" ")
'MsgBox (Rng.Text)
Id = Split(Split(Rng.Text, "ABC-")(1), "-DEF")(0)
'MsgBox (Id)
Link = "http://google.com/" & Id
ActiveDocument.Hyperlinks.Add Anchor:=Rng, _
Address:=Link, _
SubAddress:="", ScreenTip:="", TextToDisplay:=Rng.Text
Rng.Collapse wdCollapseStart
Loop
End With
End Sub
So if the text "ABC-1234-DEF" is found in the text, it will hyperlink this text with http://google.com/1234
Hope this is helpful for someone.