I am using word2003 document for processing in my document i have to made link with two string variables (Not in the sense Footnotes and Endnotes)
{Page 1} Best quote from David Brinkley[1]
{Page 6}[1] A successful person is one who can lay a firm foundation with the bricks that others throw at him
I suppose to use Footnote/Endnote for the value [1] to link but it cause some changes while editing the the Footnote/Endnote. Is there any other way to make link between the selected string?
There are probably many ways to do this, but you could bookmark the text on page 6, then add a hyperlink on page 1 that points to the bookmark. This can be done without VBA code:
Select the text for the bookmark on page 6.
Insert/Bookmark
Name the bookmark and add it
Select the text for the bookmark on page 1.
Insert/Hyperlink
Click the Bookmark button and select the bookmark in the list
The equivalent in VBA:
Option Explicit
Sub AddHyperlinkToBookmark()
Dim oBookmark As Bookmark
Dim oHyperlink As Hyperlink
'***** Add code to select text for bookmark
Set oBookmark = ThisDocument.Bookmarks.Add("BookmarkName", Selection.Range)
'***** Add code to select text for link
Set oHyperlink = ThisDocument.Hyperlinks.Add(Selection.Range, "", "BookmarkName")
Set oBookmark = Nothing
Set oHyperlink = Nothing
End Sub
Related
I'm currently inserting a sentence after the cursors position. When I insert the sentence I want to hyperlink one word in that sentence, however, for some reason the whole sentence is getting hyperlinked.
My sentence I'm inserting is "Please see {hyperlinkedText} for more information". I want the "{hyperlinkedText}" to be hyperlinked but not the whole sentence.
Please see code below.
The "titleName" is what I want to be hyperlinked and "fullText" is the senetence I'm inserting.
Dim insertText As Tuple(Of String, String, Integer) = listCheckBoxSelectedItem.SelectedItem
Dim titleName As PowerPoint.TextRange = PowePointApplication.ActiveWindow.Selection.TextRange
titleName.Text = insertText.Item1
Dim fulltext = $"Please see {titleName.Text} for more information."
Dim selectedIndex = PowePointApplication.ActiveWindow.Selection.TextRange.InsertAfter("D")
selectedIndex.Text = fulltext
With titleName.ActionSettings(PowerPoint.PpMouseActivation.ppMouseClick)
.Action = PowerPoint.PpActionType.ppActionHyperlink
.Hyperlink.SubAddress = insertText.Item3
End With
As far as I can see, in the code provided, titleName is the entire text selection, and that is why the entire text gets the hyperlink. It probably needs a sub-textrange for the piece you want to put a hyperlink on.
I've not tried this on VB, but from VBA, I believe you can use Find method of TextRange to get a new sub-TextRange just for that part, which you can then update the hyperlink settings. The code below just sets the hyperlink for the text {hyperlinkedText} part, if it is a substring of the selected text.
With ActiveWindow.Selection.TextRange.Find("{hyperlinkedText}").ActionSettings(PowerPoint.PpMouseActivation.ppMouseClick)
.Action = PowerPoint.PpActionType.ppActionHyperlink
.Hyperlink.SubAddress = "http://www.bing.com"
End With
I'm trying to fix the hyperlinks in a Word document. I need to change the SubAddress property of some hyperlinks. To that end, I'm looping through them. Unfortunately, I get a very weird error saying method 'subaddress' of object 'hyperlink' failed when I try to change any SubAddress. Apparently this happens because something is broken with VBA itself.
Sub FixHyperlinks()
'
' FixHyperlinks Macro
'
'
ActiveDocument.Hyperlinks(1).SubAddress = "some new subaddress"
End Sub
I'm rocking Office 2016 Professional Plus. Can anybody tell me if this works for you?
It's easy to test. Just create a new document, type two one-word lines. Make the second line style "Heading 1". Go to first line, hit CTRK + K (to create hyperlink) point it to "a place in this document", select the heading you just created. DO NOT enter any address. Now go to Macros, paste the above and hit F5 while your caret is inside the code.
The hyperlink works fine when clicked with the mouse (first line hyperlink will take you to the 2nd line Heading).
Although Hyperlink.SubAddress Property is supposed to be a read/write string, writing to it fails - even in Word 2010. Try something along the lines of:
Dim Rng As Range, StrAddr As String, StrTxt As String
With ActiveDocument
With .Hyperlinks(1)
Set Rng = .Range
StrAddr = .Address
StrTxt = .TextToDisplay
.Delete
End With
.Hyperlinks.Add Anchor:=Rng, Address:=StrAddr, SubAddress:="new_sub_address"
End With
In MS Word, you can create hyperlinks to a "Place in this document" so that a link takes you someplace else in the same Word file. However, if you change headers or move things around these links will sometimes break. I want to write some VBA to check for broken links.
With VBA, you can list each hyperlink subaddress using the code below:
Sub CheckLinks()
Set doc = ActiveDocument
Dim i
For i = 1 To doc.Hyperlinks.Count
Debug.Print doc.Hyperlinks(i).SubAddress
Next
End Sub
The output from the code above also matches what is shown in the field codes for the hyperlink.
However, I'm not really clear on how to verify if the SubAddress is correct. For example, an excerpt from the program output shows this:
_Find_a_Staff_1
_Edit_Organization_Settings_2
_Set_the_Staff
_Find_a_Staff_1
But there's no obvious way to tell what the "correct" suffix should be for a given heading. Any thoughts on how to check if these are valid?
Is there a way to get the list of all valid subaddresses for the headings in the document?
The code below will list the hyperlinks where the corresponding bookmark does not exist in the document. (Note that it only detects missing links, not links that go to the wrong place.)
Sub CheckLinks()
Dim doc As Document
Set doc = ActiveDocument
Dim i, j
Dim found As Boolean
For i = 1 To doc.Hyperlinks.Count
found = False
For j = 1 To doc.Bookmarks.Count
If doc.Range.Bookmarks(j).Name = doc.Hyperlinks(i).SubAddress Then
found = True
End If
Next
If found = False Then
Debug.Print doc.Hyperlinks(i).SubAddress
End If
Next
End Sub
I have built - over the years - a vba macro that is supposed to update all fields in a word document.
I invoke this macro before releasing the document for review to ensure all headers and footers etc are correct.
Currently - it look like this:
Sub UpdateAllFields()
'
' UpdateAllFields Macro
'
'
Dim doc As Document ' Pointer to Active Document
Dim wnd As Window ' Pointer to Document's Window
Dim lngMain As Long ' Main Pane Type Holder
Dim lngSplit As Long ' Split Type Holder
Dim lngActPane As Long ' ActivePane Number
Dim rngStory As Range ' Range Objwct for Looping through Stories
Dim TOC As TableOfContents ' Table of Contents Object
Dim TOA As TableOfAuthorities 'Table of Authorities Object
Dim TOF As TableOfFigures 'Table of Figures Object
Dim shp As Shape
' Set Objects
Set doc = ActiveDocument
Set wnd = doc.ActiveWindow
' get Active Pane Number
lngActPane = wnd.ActivePane.Index
' Hold View Type of Main pane
lngMain = wnd.Panes(1).View.Type
' Hold SplitSpecial
lngSplit = wnd.View.SplitSpecial
' Get Rid of any split
wnd.View.SplitSpecial = wdPaneNone
' Set View to Normal
wnd.View.Type = wdNormalView
' Loop through each story in doc to update
For Each rngStory In doc.StoryRanges
If rngStory.StoryType = wdCommentsStory Then
Application.DisplayAlerts = wdAlertsNone
' Update fields
rngStory.Fields.Update
Application.DisplayAlerts = wdAlertsAll
Else
' Update fields
rngStory.Fields.Update
If rngStory.StoryType <> wdMainTextStory Then
While Not (rngStory.NextStoryRange Is Nothing)
Set rngStory = rngStory.NextStoryRange
rngStory.Fields.Update
Wend
End If
End If
Next
For Each shp In doc.Shapes
If shp.Type <> msoPicture Then
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
End If
Next
' Loop through TOC and update
For Each TOC In doc.TablesOfContents
TOC.Update
Next
' Loop through TOA and update
For Each TOA In doc.TablesOfAuthorities
TOA.Update
Next
' Loop through TOF and update
For Each TOF In doc.TablesOfFigures
TOF.Update
Next
' Header and footer too.
UpdateHeader
UpdateFooter
' Return Split to original state
wnd.View.SplitSpecial = lngSplit
' Return main pane to original state
wnd.Panes(1).View.Type = lngMain
' Active proper pane
wnd.Panes(lngActPane).Activate
' Close and release all pointers
Set wnd = Nothing
Set doc = Nothing
End Sub
Sub UpdateFooter()
Dim i As Integer
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
'Get page count
i = ActiveDocument.BuiltInDocumentProperties(14)
If i >= 1 Then 'Update fields in Footer
For Each footer In ActiveDocument.Sections(ActiveDocument.Sections.Count).Footers()
footer.Range.Fields.Update
Next
End If
Application.ScreenUpdating = True
End Sub
'Update only the fields in your footer like:
Sub UpdateHeader()
Dim i As Integer
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
'Get page count
i = ActiveDocument.BuiltInDocumentProperties(14)
If i >= 1 Then 'Update fields in Header
For Each header In ActiveDocument.Sections(ActiveDocument.Sections.Count).Headers()
header.Range.Fields.Update
Next
End If
Application.ScreenUpdating = True
End Sub
I have noticed recently that it sometimes misses some sections of the document. Today it missed First page footer -section 2- (the document version was not updated).
I have built this macro over a number of years and several bouts of research but I am not proud of it so please suggest a complete replacement if there is now a clean way of doing it. I am using Word 2007.
To test, create a word document and add a custom field named Version and give it a value. Then use that field {DOCPROPERTY Version \* MERGEFORMAT } in as many places as you can. Headers, Footers, first-page, subsequent page etc. etc. Remember to make a multi-section document with different header/footers. Then change the property and invoke the macro. It currently does quite a good job, handling TOCs and TOAs an TOFs etc, it just seems to skip footers (sometimes) in a multi-section document for example.
Edit
The challenging document that seems to cause the most problems is structured like this:
It has 3 sections.
Section 1 is for the title page and TOC so the first page of that section has no header/footer but does use the Version property on it. Subsequent pages have page numbering in roman numerals for the TOC.
Section 2 is for the body of the document and has headers and footers.
Section 3 is for the copyright blurb and this has a very strange header and a cut-down footer.
All footers contain the Version custom document property.
My code above seems to work in all cases except sometimes it misses first page footer of sections 2 and 3.
For years, the standard I've used for updating all fields (with the exception of TOC, etc. which are handled separately) in a document is the one the Word MVPs use and recommend, which I'll copy here. It comes from Greg Maxey's site: http://gregmaxey.mvps.org/word_tip_pages/word_fields.html. One thing it does that I don't see in your version is update any fields in Shapes (text boxes) in the header/footer.
Public Sub UpdateAllFields()
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
On Error Resume Next
rngStory.Fields.Update
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
oShp.TextFrame.TextRange.Fields.Update
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
Some research and experimentation produced the following addition which seems to solve the additional problem of updating the headers/footers in a multi-section document.
Add the following dimensions to the earlier answer:
dim sctn as Word.Section
dim hdft as Word.HeaderFooter
And then, add to the earlier code
for each sctn in doc.Sections
for each hdft in sctn.Headers
hdft.Range.Fields.Update
next
for each hdft in sctn.Footers
hdft.Range.Fields.Update
next
next
However - I am still not happy with this code and would very much like to replace it with something less hacky.
Thanks for these answers! I found the answers very good and learned some stuff about ms-word macros. I thought I'd make my own answer for consideration (and adding some more search engine keywords - my searches didn't bring me here immediately).
I took inspiration from the citations in the footnotes.
I had an issue where MS Word fields were not updating in Textbox (Shapes).
I was working on a 70 page word document (Word 2013) that contained a lot of figures/images/captions and cross-references. A common practice is for an image to be captioned e.g. Figure 7, so it can be easily cross-referenced. Often the caption is inside a textbox (shape) and grouped with/to the object its captioning.
So after some document editing and content reorganisation, the fields and cross-references can easily get out of logical sequence.
OK - no problem... pressing CTRL+A then F9 to update the document fields should solve this?
Unfortunately that didn't work as expected to update fields in textboxes (shapes).
In this scenario where fields exist inside textboxes (shapes) CTRL+A then F9 only updated the fields not inside a textbox (shape).
One can assume this behaviour is because field updating (F9) works on selected text, and with the CTRL+A then F9 approach only text outside of the textboxes (shapes) is selected, so the field update only applies outside of textboxes (shapes).
I'm surprised there is not a button on the ribbon to perform an "update all fields". There could even be a toggle option to prompt the user to update all fields when closing a document?
I checked Word's (2013) ribbon command list, and didn't find an Update All command.
Solution UpdateAllFields()
Like the code shared by #Cindy here, the following code should update fields wherever they are in the doc, header, footer, main doc, textbox, grouped and nested grouped textbox.
Create a macro with the following code, and then add to the Quick Access Toolbar (QAT)
Press ALT+F8 to open the Macros dialogue.
Enter a name for the Macro: UpdateAllFields
Press Create button
Paste the code:
Sub UpdateAllFields()
Application.ScreenUpdating = False
With ActiveDocument
.Fields.Update
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
End Sub
Finally add the Macro to the Quick Access Toolbar.
Citations and inspirations:
The Q&A's in this post!
There is a related post on the Microsoft Community here: Word 365 Fields not updating in Textbox [serious reproducible error]. This suggests the issue is present in at least Word 2013 and Word 365.
There is a related post on Stack Overflow here: Macro to update fields in shapes (textboxes) in footer in Microsoft Word.
Another example UpdateTextboxFields()
This was the first version of code I wrote as I was in research and solution mode. Its a recursive approach to update fields inside textboxes, even if they are inside a group, or nested group. This doesn't update fields outside shapes.
Public Sub UpdateTextboxFields()
Application.ScreenUpdating = False
With ActiveDocument
Call IterateShapesCollection(.Shapes)
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
End Sub
Private Sub IterateShapesCollection(col)
Dim shp As Shape
For Each shp In col
' https://learn.microsoft.com/en-gb/office/vba/api/office.msoshapetype
' Ignore images and
If 1 = shp.Type Or 13 = shp.Type Then
GoTo NextIteration
End If
'Debug.Print ("Name: " & shp.Name & ", Type: " & shp.Type)
' if the type is a group, recurse
If 6 = shp.Type Then
Call IterateShapesCollection(shp.GroupItems)
Else
Call UpdateShapeFields(shp)
End If
NextIteration:
Next
End Sub
Private Sub UpdateShapeFields(shp)
With shp.TextFrame
If .HasText Then
.TextRange.Fields.Update
End If
End With
End Sub
Word display option: Update fields before printing
cite: Microsoft article Some fields are updated while other fields are not
The concept behind this option/approach is: all document fields are updated when you open print preview.
It looks like this option in Word (tested in 2013) updates all fields with a caveat - see below - you may need to open and close print preview twice.
File → Options → Display → Print options section → Update fields before printing
Caveat if the doc has cross-references to figures/captions
This caveat applies to the word "Update fields before printing" display option and the UpdateAllFields() macro.
IF the document contains cross-references to figures/captions (with numbers), and those figures/captions have changed sequence/place in the document...
You must update the fields twice, 1) to reflect the figures/captions update, and then 2) to update the cross-references.
Is it possible to search the content inside a bookmark and if it exists, do something.
For example, if there is a word document with a bookmark named Bookmark1. The enclosing text for Bookmark1 was created by highlighting the the text "Entered Text Goes Here". I want to create a macro that will check to see if the text inside the bookmark was changed, and if NOT, delete the text, the bookmark, the section break before it.
The code below does this except that it deletes the bookmark even if the text is different because it is looking for the name of the bookmark, not its content.
If ActiveDocument.Bookmarks.Exists("Bookmark1") = True Then
ActiveDocument.Bookmarks("Bookmark1").Select
Selection.Delete
With Selection
.EndKey Unit:=wdStory
.TypeBackspace
.Delete
End With
End If
I really want the If statement to say something like:
If the text inside the Bookmark1 = "Entered Text Goes Here" Then do all the stuff below, else quit.
Ideas anyone?
Word 2007.
The below should work if your document is set up how I think it is, otherwise you will need to have a play around with it:
'TestTxt is the default text in the bookmark (assuming that you are not including the paragraph mark in the bookmark)
Dim TestTxt As String: TestTxt = "Enter text here"
'DMRng is the range of the the bookmark you are looking at
Dim BMRng As Range: Set BMRng = ThisDocument.Bookmarks("Bookmark1").Range
If BMRng.Text = TestTxt Then
'Start is the beginning of the bookmark - 1 (as the character before hand should be your section break?!)
BMRng.SetRange Start:=BMRng.Start - 1, End:=BMRng.End
BMRng.Delete
End If