Insert reference to page number in Microsoft Publisher 2010 - ms-office

Question

I am new to MS Publisher 2010, and I am trying to add a "dynamic" reference to a specific page. Ideally, the visualized text should be something like:
...see the example on page XXX
I would like to make the XXX part visualize the page number of the page I am referring to. I saw that you can place bookmarks in the document, and create hyperlinks to those bookmarks, but so far I could not manage to visualize the page number tied to a bookmark.
To make another example, I would like the equivalent of this Latex expression:
...see the example on page~\pageref{reference-to-XXX}
Would it be possible to obtain this effect in Publisher 2010, maybe using a VB script? Thank you for your help!

Answer 1

http://answers.microsoft.com/en-us/office/forum/office_2007-office_other/how-do-i-hyperlink-specific-text-within-the-same/598cfd98-6217-4eac-9ac9-969477c46401?auth=1
"This is fairly easy with Pub 2007. Just Insert > bookmark and drag that icon to where you want the link to go. Then select the text >insert hyperlink > place in this document and choose the bookmark that you just created. The only time I have had problems is if the page is not long enough below the bookmark...and there are workarounds.
http://office.microsoft.com/en-us/publisher-help/create-a-hyperlink-HP010203490.aspx
DavidF"
Let me know if this helps or if you for some reason need to do it in VBA
Edit:
It is fairly easy to write a macro to refresh links to pages, but links to bookmarks seem to be poorly supported by the object model, unless I've overlooked something. My solution consists of two parts.
First of all, links that should be refreshed are recognised by their display text starting with "page " (LIKE "page *"). The refresh macro simply recognizes those links and changes their display text to page X. However, this doesn't work for links to bookmarks, which in the object model seem to behave like links to pages, except the pageID they refer to does not exist. I spent quite a while trying to figure out what the relationship might be between this non-existent hyperlink and the bookmark, but to no avail. Instead I've created a workaround in which you manually link the hyperlink and the bookmark with a tag object (creating a tag for the bookmark with the value of the non-existent page ID of the hyperlink).
Instructions for normal links to pages
Create a hyperlink to a page. The text of it must begin with ”page ”
(otherwise RefreshReferenceLinks must be edited)
Run C_RefreshReferenceLinks to refresh to check that it worked
Instructions for links to bookmarks (tagging workaround)
Create a bookmark (Insert -> Bookmark)
Create a hyperlink to the Bookmark
Select the hyperlink and run A_GetPageIdOfHyperlink
Select the bookmark and run B_TagBookmarkWithPageId
Run C_RefreshReferenceLinks to refresh to check that it worked
You can download my example project containing example content, instructions, and the macros below here: http://www.filedropper.com/showdownload.php/pageandbookmarklinks (it will probably give you a security warning because it contains macros)
Full source
Public Const tagName = "BookmarkPageId"
Sub A_GetPageIdOfHyperlink()
Dim oHyperlink As Hyperlink
Set oHyperlink = ActiveDocument.Selection.TextRange.Hyperlinks(1)
CopyText oHyperlink.pageId
MsgBox oHyperlink.pageId & " copied to clipboard as text"
End Sub
Sub B_TagBookmarkWithPageId()
Dim oShape As Shape
Set oShape = ActiveDocument.Selection.ShapeRange(1)
If IsBookmark(oShape) Then
If TagExists(oShape.Tags, tagName) Then
oShape.Tags(tagName).Delete
End If
Dim txt As String
txt = Trim(GetClipBoardText())
Debug.Print "Ssdsd:" & txt
Dim newTag As Tag
Set newTag = oShape.Tags.Add(tagName, txt)
MsgBox "Tagged as " & tagName & " = '" & txt & "'"
Else
MsgBox "Not a bookmark"
End If
End Sub
Sub C_RefreshReferenceLinks()
Dim oPage As Page
Dim oShape As Shape
For Each oPage In ActiveDocument.Pages
For Each oShape In oPage.Shapes
RefreshInShape oShape
Next oShape
Next oPage
For Each oPage In ActiveDocument.MasterPages
For Each oShape In oPage.Shapes
RefreshInShape oShape
Next oShape
Next oPage
For Each oShape In ActiveDocument.ScratchArea.Shapes
RefreshInShape oShape
Next oShape
End Sub
Function RefreshInShape(oShape As Shape)
Dim cHyperlinks As Hyperlinks
Dim oHyperlink As Hyperlink
If oShape.HasTextFrame = False Then Exit Function
Set cHyperlinks = oShape.TextFrame.TextRange.Hyperlinks
For i = 1 To cHyperlinks.Count
Set oHyperlink = cHyperlinks(i)
If oHyperlink.TargetType = pbHlinkTargetTypePageID Then
If oHyperlink.TextToDisplay Like "page *" Then
oHyperlink.TextToDisplay = "page " & GetPageNumberByPageId(oHyperlink.pageId)
End If
End If
Next i
End Function
Function GetPageNumberByPageId(pageId)
Dim oPage As Page
Dim oShape As Shape
Dim oTag As Tag
For Each oPage In ActiveDocument.Pages
If CLng(oPage.pageId) = CLng(pageId) Then
GetPageNumberByPageId = oPage.PageNumber
Exit Function
End If
Next oPage
For Each oPage In ActiveDocument.Pages
For Each oShape In oPage.Shapes
If TagExists(oShape.Tags, tagName) Then
Set oTag = oShape.Tags(tagName)
If CStr(oTag.Value) = CStr(pageId) Then
GetPageNumberByPageId = oPage.PageNumber
Exit Function
End If
End If
Next oShape
Next oPage
GetPageNumberByPageId = "[ERROR]"
End Function
Function IsBookmark(oShape As Shape)
IsBookmark = False
If oShape.Type = pbWebHTMLFragment And oShape.AutoShapeType = msoShapeMixed Then
IsBookmark = True
End If
End Function
Function TagExists(collection As Tags, itemName As String) As Boolean
TagExists = False
Dim oTag As Tag
For Each oTag In collection
If oTag.Name = itemName Then
TagExists = True
Exit For
End If
Next oTag
End Function
Function GetParentOfType(obj As Object, sTypeName As String)
Do Until TypeName(GetParentOfType) = "Page"
Set GetParentOfType = obj.Parent
Loop
End Function
Sub CopyText(Text As String)
'VBA Macro using late binding to copy text to clipboard.
'By Justin Kay, 8/15/2014
'Thanks to http://akihitoyamashiro.com/en/VBA/LateBindingDataObject.htm
Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
MSForms_DataObject.SetText Text
MSForms_DataObject.PutInClipboard
Set MSForms_DataObject = Nothing
End Sub
Function GetClipBoardText() As String
Set DataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
On Error GoTo Whoa
'~~> Get data from the clipboard.
DataObj.GetFromClipboard
'~~> Get clipboard contents
GetClipBoardText = DataObj.GetText(1)
Exit Function
Whoa:
GetClipBoardText = ""
End Function