Word VBA: Error "The requested member of the collection does not exist" for a table cell that really does exist - vba

I have a Word VBA script that adds some headings and a table to the current selection. I'm now trying to get it to pull information from the table below and put it under the correct heading. The end goal is to take the information out of table format for better navigation, because Word's outline doesn't recognize headings inside tables.
I've only gotten as far as putting table content into string variables before I get run-time error 5941: The requested member of the collection does not exist. The debugger goes to this line:
strChildren = rngSource.Tables(1).Cell(Row:=2, Column:=4).Range.Text
The table has far more than two rows and four columns. To make sure the member of the collection existed, I used another script to give me the row and column for the current selection:
Sub CellRowColumn()
'For the current selection, shows a message box with the cell row and column.
With Selection.Cells(1)
MsgBox ("Column = " & .ColumnIndex & vbCr & "Row = " & .RowIndex)
End With
End Sub
I ran this one in the cell I want to copy from, and it does show Row 2 & Column 4.
This is the code I'm using:
Sub ElementHeadings()
'With the current selection, adds the headings for each element in the
'Elements and Attribute List (Description, Parent(s), and Child(ren)) and
'a table for attributes, with 3 columns, headed "Attribute
'Name", "Attribute Required?" and "Attribute Content")
Dim rngSelection As Range
Dim rngTable As Range
Dim rngHeading As Range
Dim rngSource As Range
Dim strCaption As String
Dim lngCaptionLength As Long
Dim strDescr As String
Dim strParents As String
Dim strChildren As String
Dim strVol As String
Dim strUsedIn As String
Set rngSelection = Selection.Range
'msgBox (rngSelection.Text)
With rngSelection
.InsertAfter ("Description")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Parent(s)")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Child(ren)")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertParagraphAfter
.InsertParagraphAfter
Set rngTable = .Paragraphs(5).Range
.InsertAfter ("Volume & Chapter")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Used In")
.Expand unit:=wdParagraph
.Style = "Heading 4"
'MsgBox (rngSelection.Text)
End With
ActiveDocument.Tables.Add Range:=rngTable, NumRows:=3, NumColumns:=3
With rngTable
.Tables(1).Cell(1, 1).Range.Text = "Attribute Name"
.Tables(1).Cell(1, 2).Range.Text = "Attribute Required?"
.Tables(1).Cell(1, 3).Range.Text = "Attribute Content"
.Select
GenericMacros.TableFormat
.Move unit:=wdParagraph, Count:=-1
.Select
End With
rngSelection.Select
Set rngHeading = Selection.GoTo(what:=wdGoToHeading, Which:=wdGoToPrevious)
rngHeading.Expand unit:=wdParagraph
'MsgBox (rngHeading.Text)
rngTable.Select
strCaption = rngHeading.Text
lngCaptionLength = Len(strCaption)
strCaption = Left(strCaption, lngCaptionLength - 1)
Selection.InsertCaption Label:=wdCaptionTable, Title:=". <" _
& strCaption & "> Attribute Table"
rngSelection.Select
Set rngSource = Selection.GoTo(what:=wdGoToTable, Which:=wdGoToNext)
rngSource.Expand unit:=wdTable
strDescr = rngSource.Tables(1).Cell(Row:=2, Column:=2).Range.Text
strParents = rngSource.Tables(1).Cell(Row:=2, Column:=3).Range.Text
strChildren = rngSource.Tables(1).Cell(Row:=2, Column:=4).Range.Text
strVol = rngSource.Tables(1).Cell(Row:=2, Column:=8).Range.Text
strUsedIn = rngSource.Tables(1).Cell(Row:=2, Column:=9).Range.Text
MsgBox ("strDescr = " & strDescr & vbCr & "strParents = " & strParents & _
vbCr & "strChildren =" & strChildren & vbCr & "str3001Vol = " _
& str3001Vol & "strUsedIn = " & strUsedIn)
End Sub
(This may end up being a SuperUser question rather than a Stack Overflow question, if the problem is the document rather than my code. Previously, I was having trouble copying and pasting from the table (copying text but not getting the option to paste it above), but that's no longer happening. So if there's not an apparent issue with the code, maybe it's document corruption or some other Word weirdness.)
Update: My source range contained the table I had just created, rather than the one I wanted to pull from, so I fixed the Selection.Goto that was creating rngSource.

Good that you were able to track down where your code was failing. Working with the Selection object tends to be unreliable as it may not be where you're assuming (or where it was) when you wrote the code.
It's much better to work with Word's objects as whenever possible. For example, when you create a table, Dim a variable, then assign to it when you create the table. That gives you a "handle" on the table, no matter what kind of editing takes place before it, later:
Dim tbl as Word.Table
Set tbl = ActiveDocument.Tables.Add(Range:=rngTable, NumRows:=3, NumColumns:=3).
tbl.Cell(1,1).Range.Text = "Attribute Name"
'and so on...
To pick up an existing table you need to be able to identify it. If you're certain of the position, then:
Set tbl = ActiveDocument.Tables([index value])
If this is a "template" kind of document that you set up and re-use you can bookmark the table (select the table and insert a bookmark, or click in the first cell and insert a bookmark), then:
Set tbl = ActiveDocument.Bookmarks("BookmarkName").Range.Tables(1)
In a similar vein, you can replace this:
rngHeading.Expand unit:=wdParagraph
with the following if you want to work with the paragraph, explicitly:
Dim para as Word.Paragraph
Set para = rngHeading.Paragraphs(1)
It may also help you to know you can "collapse" a Range (similar to pressing the Arrow key with a selection) to its start or end point. This is useful if you want to add something, format it, then add something else that should have different formatting... (as an alternative to using InsertAfter consecutively then going back and formatting things differently).

I got something like OP, and after running below code:
Dim tbl As Word.Table: Set tbl = doc.Tables(2)
MsgBox tbl.Cell(1, 1).Range.Text
Which works on the idea that each table should have at least one cell in it,
did notice that I was accessing the wrong table too ;-)
So, you may use that first to get sure.

Related

How to set cursor after a table in word document using VBA

I've to create a report in Word document without a template. This report consists of records from MS Access - and there will be some text and then a table, iterative based on # of records (I'll be creating tables dynamically using VBA based on the # of records).
I can start inserting text in the word document using a bookmark as starting point and then able to add a table and fill in cells. The question once done filling in the table how can I place the cursor on the next line after table to start inserting text.
following is my code anyone with some hints or example would appreciate - Thanks!
Set wordObj = CreateObject("Word.Application")
Set wordDoc = wordObj.Documents.Open(fileName:=wrdTMPLT, Visible:=True)
wordDoc.Bookmarks("rptdate").Range.Text = Format(DATE, "dd-mmm-yyyy")
Set wordrange = wordDoc.GoTo(what:=wdGoToBookmark, Name:="startpoint") 'set cursor to start point
wordrange.Text = Me.Text3_CHK
Set wordrange = wordDoc.GoTo(what:=wdGoToBookmark, Name:="tblpoint") 'set cursor to location to insert table
Set tbl = wordDoc.Tables.Add(Range:=wordrange, numrows:=4, numcolumns:=2)
tbl.CELL(1, 1).Merge MergeTo:=tbl.CELL(1, 2)
tbl.CELL(3, 1).Merge MergeTo:=tbl.CELL(3, 2)
tbl.CELL(4, 1).Merge MergeTo:=tbl.CELL(4, 2)
tbl.CELL(1, 1).Range.InsertAfter "Title: "
tbl.CELL(2, 1).Range.InsertAfter "Coordinator: "
tbl.CELL(2, 2).Range.InsertAfter "Engineer: "
tbl.CELL(3, 1).Range.InsertAfter "Vendor 1: "
tbl.CELL(3, 2).Range.InsertAfter "Vendor 2: "
tbl.CELL(4, 1).Range.InsertAfter "Contractor: "
tbl.Borders.Enable = False
'Following text to enter after the table above
wordrange.Text = "HellO"
'continue with next table ... n text/table cycle based # of records
To get to the point (paragraph) following a table, assign the table's Range to a Range object then collapse it to its end-point:
Dim rng as Word.Range
'Do things here until table is finished
Set rng = tbl.Range
rng.Collapse wdCollapseEnd
'Now the Range is after the table, so do things with it, for example:
rng.Text = "more text"

How to refer to a line or table row I've just inserted

I feel I must be missing something obvious. I'm using VBA to build a Word document by writing lines to it one at a time. Once I've written a line, I need to format it - this could be bolding, setting tabstops, etc. But in order to format a line, I have to be able to refer to it. All the formatting facilities operate on a Range or a Selection - how do I identify the line I've just inserted as the Range I want to operate on? (Also, same question for table rows, as the doc also includes tables I'm building one row at a time, and I need to format cells as I go).
This is how to insert text and format it as you go, using a Range object. It's better to not try to simulate how a user works by using Selection and TypeText. The code runs more slowly and it's more difficult to work precisely. There can be only one Selection, but code can work with many Ranges...
The other important point to remember is to declare and instantiate objects as they're created - tables and table rows, for example.
Dim rng1 as Word.Range, rng2 as Word.Range
Set rng1 = ActiveDocument.Content
rng1.Text = "line one" & vbCr
rng1.Font.Bold = True
rng1.Collapse wdCollapseEnd
rng1.Text = "line two" & vbCr
rng1.Font.Bold = False
rng1.Collapse wdCollapseEnd
Set rng2 = rng1.Duplicate
rng2.Text = "line three" & vbCr
rng2.Font.Italic = True
'You can still work with the first range
rng1.ParagraphFormat.Alignment = wdAlignParagraphCenter
'
Dim tbl as Word.Table, rw1 as Word.Row, rw2 as Word.Row
Set tbl = ActiveDocument.Tables.Add
Set rw1 = tbl.Rows(1)
Set r2 = tbl.Rows.Add
Sub FormatBold()
Dim StartWord As String, EndWord As String
StartWord = "STARTSTART"
EndWord = "ENDEND"
With ActiveDocument.Content.Duplicate
.Find.Execute Findtext:=StartWord & "*" & EndWord, MatchWildcards:=True
.MoveStart wdCharacter, Len(StartWord)
.MoveEnd wdCharacter, -Len(EndWord)
.Font.Bold = True ' Or whatever you want to do
End With
End Sub
Format the text while you write it:
Sub StartTyping()
Selection.TypeText Text:="This is the "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="sentence"
Selection.Font.Bold = wdToggle
Selection.TypeText Text:=" I am inserting." & vbCr
End Sub

excel-vba: Turn text from cells with particular format into an object suitable for outlook e-mail body, while maintaining the same format properties

My problem is the following:
I want to define a range, including cells in my spreadsheet that contain formatted text (bold font), and turn it into any object that I can later use as the body for an outlook e-mail.
One of the ways I have tried so far is via the RangetoHTML function by Ron de Bruin (http://www.rondebruin.nl/win/s1/outlook/bmail2.htm). However, the function brings the text cells into another excel workbook which finally yields a table in the outlook e-mail. I want to keep the very same format that I start with in my excel cells. That is, it must be lines of ordinary text and not a table-like body in the mail.
That's my current code:
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Sheets("Preparation").Range("A90:A131")
With Selection
.Value = rng.Text
.Font.Bold = rng.Font.Bold
.Font.Color = rng.Font.Color
End With
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.HTMLBody = RangetoHTML(rng)
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Thanks in advance for your help
Ron de Bruin’s RangeToHtml shows how to use Excel’s PublishObjects to convert a worksheet range to Html that can be used as the body of an email. I am sure this has helped thousands of developers.
The difficulty that RdeB overcomes is that PublishObjects is designed to create and maintain webpages. His routine outputs to a file and then reads that file because that is the only way to get the Html string required for the email body.
The difficulty that RdeB cannot overcome is that PublishObjects create poor quality, proprietary CSS. By “poor quality”, I mean that there is a lot of unnecessary CSS and that row heights and column widths are defined in points to give sizes suitable for a PC. By “proprietary”, I mean it uses styles such as mso-ignore:padding and mso-number-format:General that only Microsoft browsers are guaranteed to understand. It appears the major browsers are able to cope but many people have found that some newer browsers cannot cope and display rubbish.
To demonstrate this and to test my code, I created a worksheet based on your image. Rows 16 to 18 are right-aligned because I have specified this. Rows 20 to 22 are right aligned because this is the Excel default for numeric, date and time values. Its appearance is:
You can use your real data.
Copy this code to your workbook:
Option Explicit
Sub Test1()
Dim PathCrnt As String
Dim PathFileCrnt As String
Dim RngStr As String
Dim WshtName As String
PathCrnt = ThisWorkbook.Path & "\" ' ## Output to the same folder as workbook holding the macro
PathFileCrnt = PathCrnt & "Test1.html" ' ## Change if you do not like my filename
WshtName = "Sheet1" ' ## Change to your worksheet
RngStr = "A1:A28" ' ## Change to your range
With ThisWorkbook
With .PublishObjects.Add(SourceType:=xlSourceRange, _
Filename:=PathFileCrnt, _
Sheet:=WshtName, _
Source:=RngStr, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
End With
End Sub
You will need to change some of the statements near the top marked with ##
Run this macro to output your range to the file.
On my laptop, Microsoft Edge, Microsoft Internet Explorer and Google Chrome all display the file and all look the same although IE and Chrome are slow to display. The column is down the centre of the window:
There are none of the background grey cells and wide, white border you showed. However, I have not tried to display it within Outlook.
Now look at the file with your favourite text editor. Notice how much CSS is repeated. Notice how many style start “mso-” indicating they are Microsoft extensions. Notice the heights and widths measured in “pt” (points). Some Html display engines can cope but some cannot.
I suspect that PublishObjects has not been maintained. It was available with Excel 2003 and perhaps earlier. Some of the old Microsoft CSS extensions now have standard CSS equivalents but PublishObjects has not been updated to use them.
I have my own RangeToHtml written entirely in VBA. It will handle all formatting except borders. My code is far too big to post on Stack Overflow so I have extracted the bits you need. You apparently need bold or not bold and left or right alignment. I do not know if you specify right alignment or if you have numeric fields which right align by default so I handle both.
My function ColToHtml(range) returns a complete Html file for the first column of a range. My code does not create a temporary workbook or a temporary file. It produces clean, crisp Html and Css. It produces a table because you cannot have right-alignment outside a table. However, with no borders, it is not obvious the output is a table. The only difference in appearance is that the table is left aligned. If you prefer a centred table, it would be an easy change.
This was my test routine:
Sub Test2()
Dim Rng As Range
With Worksheets("Sheet1")
Set Rng = .Range(.Cells(1, 1), .Cells(28, 1))
End With
Debug.Print ColumnToHtml(Rng)
End Sub
It outputs the Html string to the Immediate Window. I then copied it to a file. I could have used VBA to write to a file but this was easier. When I opened the file with Microsoft Edge, it looked the same. Have a look at this second file with your favourite text editor. Notice how much smaller it is. The PublishObjects version is 6,901 bytes while this second version is 1,681 bytes. Notice how only standard Css is used and that the minimum of Css is used. This allows the display engine to make its own decisions about how to display the file based on the type of output device.
My last test was:
Sub Test3()
' This will need a reference to Microsoft Outlook nn.0 Outlook library
' where nn is the number of the Outlook version you are using.
Dim Rng As Range
Dim OutApp As Outlook.Application
Dim MailItemNew As Outlook.MailItem
With Worksheets("Sheet1")
Set Rng = .Range(.Cells(1, 1), .Cells(28, 1))
End With
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set MailItemNew = OutApp.CreateItem(olMailItem)
With MailItemNew
.BodyFormat = olFormatHTML
.HTMLBody = ColumnToHtml(Rng)
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set MailItemNew = Nothing
Set OutApp = Nothing
End Sub
This outputs the range to Outlook. I have used your code as a template but have referenced the Outlook library so I can use Outlook objects and constants. I had to reduce the font size to get it all on the screen at one time giving:
Again this has the same appearance except that the first letter of each line has been capitalized. I do not know how to stop the Outlook email editor doing this.
Incidentally, I selected the entire email and got the same appearance as in the image you posted.
The code for ColumnToHtml is below. Note that CellToHtml is the routine that actually creates the Html for a cell. It only handles bold and right alignment but it should be obvious that it would be easy to add other cell-level formats.
Function ColumnToHtml(ByRef RngCol As Range) As String
' Returns the first or only column of rng as a borderless table
' so it appears as a formatted list of rows.
Dim RngCell As Range
Dim RowCrnt As Long
Dim Table As String
' Build an Html table of the cells within the first column of RngCol
' ==================================================================
Table = Space(4) & "<table border=""0"">" & vbLf
For RowCrnt = RngCol.Row To RngCol.Row + RngCol.Rows.Count - 1
Set RngCell = RngCol.Worksheet.Cells(RowCrnt, RngCol.Column)
Table = Table & Space(6) & "<tr>" & CellToHtml(RngCell) & "</tr>" & vbLf
Next
Table = Table & Space(4) & "</table>"
' Build an Html file envelope around the table
' ============================================
ColumnToHtml = "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Frameset//EN""" & _
"""http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"">" & vbLf & _
"<html xmlns=""http://www.w3.org/1999/xhtml"" xml:lang=""en"" lang=""en"">" & vbLf & _
" <head></head>" & vbLf & _
" <meta http-equiv=""Content-Type""content=""text/html; charset=utf-8""/>" & vbLf & _
" <style>" & vbLf & _
" td.bold {font-weight:bold;}" & vbLf & _
" td.hAlign-right {text-align:right;}" & vbLf & _
" </style>" & vbLf & _
" </head>" & vbLf & _
" <body>" & vbLf & Table & vbLf & _
" </body>" & vbLf & _
"</html>"
End Function
Function CellToHtml(ByRef RngCell As Range) As String
' Convert a single cell to Html.
' This code handles: value, bold or not-bold (default) and left )default) or
' right-alignment.
' Note RngCell.Value is the value perhaps "1234" or "42999".
' and RngCell.Text is the display text perhaps "1,234" or "21-Sep-17".
' This is particularly important with dates and time where the
' value is unlikely to be what is displayed.
' Dates are held as days since 1-Jan-1900 and times are held as
' seconds-since-midnight / seconds-in-a-day. It is the NumberFormat that
' determine what you see.
Dim BoldCell As Boolean
Dim RAlignedCell As Boolean
Dim Style As String
Dim StyleNeeded As Boolean
CellToHtml = "<td"
' Add interior formatting here if required
If RngCell.Value = "" Then
' Ignore font and alignment formatting of empty cell.
Else
' Test for formats
BoldCell = False
RAlignedCell = False
Style = ""
StyleNeeded = False
If RngCell.Font.Bold Then
BoldCell = True
StyleNeeded = True
End If
If RngCell.HorizontalAlignment = xlRight Or _
(RngCell.HorizontalAlignment = xlGeneral And _
(IsNumeric(RngCell.Value) Or IsDate(RngCell.Value))) Then
RAlignedCell = True
StyleNeeded = True
End If
If StyleNeeded Then
CellToHtml = CellToHtml & " class="""
If BoldCell Then
If Style <> "" Then
Style = Style & " "
End If
Style = Style & "bold"
End If
If RAlignedCell Then
If Style <> "" Then
Style = Style & " "
End If
Style = Style & "hAlign-right"
End If
CellToHtml = CellToHtml & Style & """"
End If
End If
CellToHtml = CellToHtml & ">" ' Terminate "<td"
If RngCell.Value = "" Then
' Blank rows are displayed narrow. Use Non-blank space so display at homral width
CellToHtml = CellToHtml & " "
Else
CellToHtml = CellToHtml & RngCell.Text
End If
CellToHtml = CellToHtml & "</td>"
End Function
One last comment. You have not selected anything so I do not see the purpose of this code:
With Selection
.Value = rng.Text
.Font.Bold = rng.Font.Bold
.Font.Color = rng.Font.Color
End With

VBA to insert reference page into MS word endnote

Book endnotes often forgo superscript numbers for page numbers. E.g., instead of
Abe Lincoln was assassinated with a pistol.^33
:
33. A single-shot derringer pistol.
books by several authors write
Abe Lincoln was assassinated with a pistol.
:
Page 297. Abe Lincoln was shot single-shot derringer pistol.
Word doesn't have this feature, so I believe it would have to be a Macro. I came up with simple code below that loops through all of the endnotes and adds
"Page ???. "
before each endnote, but what does "???" need to be to correctly insert the page number in my manuscript that the citation's located on?
Sub RedefineExistingEndNotes()
Dim fn As Endnote
For Each fn In ActiveDocument.Endnotes
fn.Range.Paragraphs(1).Range.Font.Reset
fn.Range.Paragraphs(1).Range.Characters(1).InsertBefore "Page" & "???" & " - "
Next fn
End Sub
Try the below VBA code:
Sub InsertPageNumberForEndnotes()
Dim endNoteCount As Integer
Dim curPageNumber As Integer
If ActiveDocument.Endnotes.Count > 0 Then
For endNoteCount = 1 To ActiveDocument.Endnotes.Count
Selection.GoTo What:=wdGoToEndnote, Which:=wdGoToAbsolute, Count:=endNoteCount
curPageNumber = Selection.Information(wdActiveEndPageNumber)
ActiveDocument.Endnotes(endNoteCount).Range.Select
ActiveDocument.Application.Selection.Collapse (WdCollapseDirection.wdCollapseStart)
ActiveDocument.Application.Selection.Paragraphs(1).Range.Characters(1).InsertBefore "Page " & CStr(curPageNumber) & " - "
Next
End If
End Sub
An alternative might be to use PAGEREF fields and hide the endnote references, e.g.
Sub modifyEndNotes()
Const bookmarkText As String = "endnote"
Dim en As Word.Endnote
Dim rng As Word.Range
For Each en In ActiveDocument.Endnotes
en.Reference.Bookmarks.Add bookmarkText & en.Index
en.Reference.Font.Hidden = True
Set rng = en.Range
rng.Paragraphs(1).Range.Font.Hidden = True
rng.Collapse WdCollapseDirection.wdCollapseStart
rng.Text = "Page . "
rng.SetRange rng.End - 2, rng.End - 2
rng.Fields.Add rng, WdFieldType.wdFieldEmpty, "PAGEREF " & bookmarkText & en.Index & " \h", False
'if necessary...
'rng.Fields.Update
en.Range.Font.Hidden = False
Next
Set rng = Nothing
End Sub
For a second run, you'd need to remove and re-insert the text and fields you had added.
Unfortunately, a further look suggests that it would be difficult, if not impossible, to hide the endnote references (in the endnotes themselves) without hiding the paragraph marker at the end of the first endnote para, which means that all the endnotes will end up looking like a single messy note. So I deleted this Answer.
However, the OP thought the approach could be modified in a useful way so I have undeleted. I can't re-research it right away but some possibilities might be to replace every endnote mark by a bullet (as suggested by the OP) or perhaps even something as simple as a space or a "-".
For example, something like this (which also hides the references using a different technique)...
Sub modifyEndNotes2()
' this version also formats the endnotes under page headings
Const bookmarkText As String = "endnote"
Dim en As Word.Endnote
Dim f As Word.Field
Dim i As Integer
Dim rng As Word.Range
Dim strSavedPage As String
strSavedPage = ""
For Each en In ActiveDocument.Endnotes
en.Reference.Bookmarks.Add bookmarkText & en.Index
Set rng = en.Range
rng.Collapse WdCollapseDirection.wdCollapseStart
If CStr(en.Reference.Information(wdActiveEndPageNumber)) <> strSavedPage Then
strSavedPage = CStr(en.Reference.Information(wdActiveEndPageNumber))
rng.Text = "Page :-" & vbCr & " - "
rng.SetRange rng.End - 6, rng.End - 6
rng.Fields.Add rng, WdFieldType.wdFieldEmpty, "PAGEREF " & bookmarkText & en.Index & " \h", False
rng.Collapse WdCollapseDirection.wdCollapseEnd
Else
rng.Text = "- "
End If
Next
If ActiveDocument.Endnotes.Count > 1 Then
ActiveDocument.Styles(wdStyleEndnoteReference).Font.Hidden = True
Else
ActiveDocument.Styles(wdStyleEndnoteReference).Font.Hidden = False
End If
Set rng = Nothing
End Sub
In the above case, notice that there is only one link to each page, that formatting might be needed to make it obvious that it is a link, and so on.

How do I strip all formatting out of this Word VBA output and use the "Normal" quickstyle?

I am using the following VBA macro to add page numbers after all bookmark hyperlinks in my document:
Sub InsertPageRefs()
Application.ScreenUpdating = False
Dim hLnk As Hyperlink, Rng As Range
For Each hLnk In ActiveDocument.Hyperlinks
With hLnk
If InStr(.SubAddress, "_Toc") = 0 And .Address = "" Then
Set Rng = .Range
With Rng
.Collapse Direction:=wdCollapseEnd
.InsertAfter Text:=" (See page #)"
.Font.Underline = wdUnderlineNone
End With
ActiveDocument.Fields.Add Range:=Rng.Characters(InStr(Rng, "#")), Text:="PAGEREF " & .SubAddress
End If
End With
Next
Set Rng = Nothing
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox ActiveDocument.Hyperlinks.Count & " page numbers have been added.", vbOKOnly
End Sub
However, it's having undesirable results.
The blue color of the hyperlinks is partially spilling over into the added text.
It's creating a bunch of crazy span tags when I save the resulting file to HTML. I don't want this because I am going to convert the HTML to .mobi for Kindle and all the span tags are going to create chaos in my .mobi.
How do I strip out all the formatting and insert the page numbers in the "Normal" word style?
I suspect the real answer for this would be to use a good e-book editor that will keep track of this for you.
That said, the problem is likely that you are working on the Hyperlink's range, so all you should have to do is duplicate it. This allows the formatting of your range separate itself from whatever formatting is attached to the hyperlink. The other benefit of using a duplicate of a Hyperlink's range is that you can operate on the text of the range directly without destroying the link, which is also an easy way to preserve the target formatting:
Sub InsertPageRefs()
Dim hLnk As Hyperlink
Dim Rng As Range
For Each hLnk In ActiveDocument.Hyperlinks
If InStr(hLnk.SubAddress, "_Toc") = 0 And hLnk.Address = vbNullString Then
Set Rng = hLnk.Range.Duplicate
Rng.Start = Rng.End
Rng.Text = " (See page #)"
Rng.Font.Underline = wdUnderlineNone
ActiveDocument.Fields.Add Range:=Rng.Characters(InStr(Rng, "#")), _
Text:="PAGEREF " & hLnk.SubAddress
End If
Next
MsgBox ActiveDocument.Hyperlinks.Count & " page numbers have been added.", vbOKOnly
End Sub
Note that I pulled out the With blocks to make this more readable. Nested Withs make it a lot more difficult to tell at a glance what object you're operating on.