Adamski
05-20-2011, 09:21 AM
I want to bookmark ranges. I only want to create a bookmark if one does not alreay exist for a given range. I am determining the ranges based on SEQ fields.
The problem is that bookmarking a field.range seems to create a bookmark with a range different to the field.range. I have played with MoveEnd and MoveStart but something is still wrong.
For Equations, I want include an extra field imediately before the {SEQ Equation} in the bookmark. It is the chapter number and a dash.
SomeEquation (1-1)
Bookmarked:
SomeEquation ([1-1])
I'd rather not have to rely on the brackets being there to determin the range.
At the moment, more bookmarks keep getting created for the same range.
Help most welcome,
TIA
Public Sub OnActionButton_InsertCaptionReference(control As IRibbonControl)
' MsgBox "Id : " & control.id & vbCrLf & _
' "Tag: " & control.Tag, vbInformation, "OnActionButton_InsertCaptionReference"
Dim oField As Field
On Error Resume Next
Set oField = ActiveDocument.Fields(control.Tag)
On Error GoTo 0
If Not oField Is Nothing Then
Dim sCode As String
sCode = oField.Code.Text
Dim oRange As Range
Set oRange = oField.Code.Duplicate
' Move End out of field
oRange.MoveEnd Unit:=wdCharacter, count:=1
' What sort of Caption
If InStr(sCode, "Table") <> 0 Then
oRange.StartOf Unit:=wdParagraph, Extend:=wdExtend
ElseIf InStr(sCode, "Figure") <> 0 Then
oRange.StartOf Unit:=wdParagraph, Extend:=wdExtend
ElseIf InStr(sCode, "Equation") <> 0 Then
oRange.StartOf Unit:=wdWord, Extend:=wdExtend
oRange.MoveStart Unit:=wdCharacter, count:=-1
End If
' Bookmark It
Dim oBookmark As Bookmark
Set oBookmark = GetRangeBookmark(oRange, "_CapRef")
Debug.Print "Bookmark Name: " & oBookmark.Name
' Insert Reference to Bookmark
Selection.ShrinkDiscontiguousSelection
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldRef, _
Text:=oBookmark.Name, PreserveFormatting:=False
End If
End Sub
Function GetRangeBookmark(oRange As Range, Prefix As String) As Bookmark
' Try to get existing bookmark
Dim oBookmark As Bookmark
For Each oBookmark In oRange.Bookmarks
If oBookmark.Range.IsEqual(Range:=oRange) = True Then
Set GetRangeBookmark = oBookmark
Exit For
End If
Next oBookmark
' Create bookmark if necessary
If GetRangeBookmark Is Nothing Then
Dim BookmarkName As String
BookmarkName = Prefix & DateDiff("s", 0, Now)
While ActiveDocument.Bookmarks.Exists(BookmarkName)
BookmarkName = "_CapRef" & DateDiff("s", 0, Now)
Wend
Set GetRangeBookmark = ActiveDocument.Bookmarks.Add(BookmarkName, oRange)
End If
End Function
The problem is that bookmarking a field.range seems to create a bookmark with a range different to the field.range. I have played with MoveEnd and MoveStart but something is still wrong.
For Equations, I want include an extra field imediately before the {SEQ Equation} in the bookmark. It is the chapter number and a dash.
SomeEquation (1-1)
Bookmarked:
SomeEquation ([1-1])
I'd rather not have to rely on the brackets being there to determin the range.
At the moment, more bookmarks keep getting created for the same range.
Help most welcome,
TIA
Public Sub OnActionButton_InsertCaptionReference(control As IRibbonControl)
' MsgBox "Id : " & control.id & vbCrLf & _
' "Tag: " & control.Tag, vbInformation, "OnActionButton_InsertCaptionReference"
Dim oField As Field
On Error Resume Next
Set oField = ActiveDocument.Fields(control.Tag)
On Error GoTo 0
If Not oField Is Nothing Then
Dim sCode As String
sCode = oField.Code.Text
Dim oRange As Range
Set oRange = oField.Code.Duplicate
' Move End out of field
oRange.MoveEnd Unit:=wdCharacter, count:=1
' What sort of Caption
If InStr(sCode, "Table") <> 0 Then
oRange.StartOf Unit:=wdParagraph, Extend:=wdExtend
ElseIf InStr(sCode, "Figure") <> 0 Then
oRange.StartOf Unit:=wdParagraph, Extend:=wdExtend
ElseIf InStr(sCode, "Equation") <> 0 Then
oRange.StartOf Unit:=wdWord, Extend:=wdExtend
oRange.MoveStart Unit:=wdCharacter, count:=-1
End If
' Bookmark It
Dim oBookmark As Bookmark
Set oBookmark = GetRangeBookmark(oRange, "_CapRef")
Debug.Print "Bookmark Name: " & oBookmark.Name
' Insert Reference to Bookmark
Selection.ShrinkDiscontiguousSelection
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldRef, _
Text:=oBookmark.Name, PreserveFormatting:=False
End If
End Sub
Function GetRangeBookmark(oRange As Range, Prefix As String) As Bookmark
' Try to get existing bookmark
Dim oBookmark As Bookmark
For Each oBookmark In oRange.Bookmarks
If oBookmark.Range.IsEqual(Range:=oRange) = True Then
Set GetRangeBookmark = oBookmark
Exit For
End If
Next oBookmark
' Create bookmark if necessary
If GetRangeBookmark Is Nothing Then
Dim BookmarkName As String
BookmarkName = Prefix & DateDiff("s", 0, Now)
While ActiveDocument.Bookmarks.Exists(BookmarkName)
BookmarkName = "_CapRef" & DateDiff("s", 0, Now)
Wend
Set GetRangeBookmark = ActiveDocument.Bookmarks.Add(BookmarkName, oRange)
End If
End Function