![]() |
#1
|
|||
|
|||
![]()
I have a rather difficult (maybe not for experts!) request.
I have a large MS Word document (Office 365) which contains links to bookmarks. What I would like to do is to place the paragraph at the bookmark in-line with the text in square brackets. I attach a small example. I would appreciate any help I can get. My VBA skills are rather skimpy. |
#2
|
|||
|
|||
![]()
Hi, this was a fun one.
I'm still learning VBA, so this could very likely be improved upon, but in my test, it resulted in exactly what you listed as your end goal. Some areas that might need changed based on your documents:
Code:
Sub bhh_inlineBookmarks() ' Written by Brian Hoard, www.BrianHoard.com Dim scriptName As String scriptName = "bhh_inlineBookmarks" Application.ScreenUpdating = False ' Begin undo record Dim bhhUndo As UndoRecord Set bhhUndo = Application.UndoRecord bhhUndo.StartCustomRecord (scriptName) Dim f As Field Dim rngSource As Range Dim rng_bm As Range Dim i As Integer i = 1 ' Begin hyperlink counter For Each f In ActiveDocument.Fields If f.Type = wdFieldHyperlink Then f.Select Set rngSource = Selection.Range f.Delete ' Delete the link ' Define the range in the document body where the bookmark is at. With rngSource .Collapse .Font.Superscript = False End With ' Process the linked text. ' NOTE: This is subject to problems if the document includes hyperlinks that are not bookmarks. Set rng_bm = ActiveDocument.Bookmarks.Item(i).Range With rng_bm .Expand wdParagraph ' Expand the range to the full paragraph .End = .End - 1 ' Bring range End to the left 1 character to exclude the carriage return. End With rngSource.Text = (" [" & rng_bm.Text & "]") End If ' /f.Type = wdFieldHyperlink i = (i + 1) ' increment bookmark counter Next f ' End undo bhhUndo.EndCustomRecord Application.ScreenUpdating = True End Sub |
#3
|
|||
|
|||
![]()
Thank you very much. I will test it on my large document.
|
#4
|
|||
|
|||
![]()
The following code will process the hyperlinks and the referenced bookmarked locations in the same document. The hyperlinks are replaced with the text from the bookmark and will retain the formatting of that text.
Code:
Sub MoveHyperlinkedText() Dim hlIdx As Long, hlink As Hyperlink, hlRng As Range Dim bmName As String, bmRng As Range If ActiveDocument.Hyperlinks.Count > 0 And ActiveDocument.Bookmarks.Count > 0 Then Application.ScreenUpdating = False 'because hyperlinks will be deleted it is necessary to process them in reverse order For hlIdx = ActiveDocument.Hyperlinks.Count To 1 Step -1 Set hlink = ActiveDocument.Hyperlinks(hlIdx) If hlink.Type = msoHyperlinkRange Then 'ignore any hyperlinked shapes If hlink.Address = vbNullString Then 'it's a link to a location in the same document so ensure that it exists bmName = hlink.SubAddress If ActiveDocument.Bookmarks.Exists(bmName) Then 'get range of bookmarked paragraph, minus the paragraph mark Set bmRng = ActiveDocument.Bookmarks(bmName).Range With bmRng .Expand wdParagraph .End = .End - 1 End With Set hlRng = hlink.Range hlink.Delete With hlRng 'turn off superscript and replace text with brackets .Font.Superscript = False .Text = " []" .Start = .Start + 2 .End = .End - 1 'add the bookmarked text and its formatting .FormattedText = bmRng.FormattedText End With End If End If End If Next hlIdx Application.ScreenUpdating = True End If End Sub |
#5
|
|||
|
|||
![]()
Thank you very much for this. It does exactly what I need.
|
#6
|
|||
|
|||
![]()
Good day Italophile,
Why would I get "Command failed" on the statement: If hlink.Address = vbNullString Then Regards, WS |
![]() |
Tags |
hyperlink text |
Thread Tools | |
Display Modes | |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Hyperlink to specific place in PDF | michal.berenc | Visio | 1 | 11-23-2017 08:55 AM |
Creating A Keyboard Shortcut In Place of Using Mouse To Select Hyperlink Object | PowerPointerNeedsHelp | PowerPoint | 3 | 07-06-2017 01:47 AM |
![]() |
Subterfuge | Word Tables | 2 | 09-22-2016 08:01 AM |
![]() |
atelem | Word | 9 | 06-22-2016 03:31 PM |
![]() |
anurag.butoliya | Word | 1 | 06-14-2014 06:27 PM |