none
more fun with cross references (Word 2010) RRS feed

  • General discussion

  • Hi all,

    I often and extensive use cross references.
    Cross refs offer a good way to organize large documents.

    But the handling in Word is very circuitous.
    It starts when u create one and it does not end with the management of existing references :(

    Because I'm a keyboard-driven user (not a Mousepusher ;-), I always want to know, how things can be done using the keyboard.

    The first thing therefore is how can I "click" a cross reference field with the keyboard to goto the links target.
    Here is my answer (VBA-macro) :

    ' jumps to a cross referenced paragraph
    Public Sub followReference()
        Dim vSt1 As String
    
        On Error Resume Next
        Selection.Expand
    
        vSt1 = Selection.Fields(1).Code
        vSt1 = Split(vSt1, " ")(2)
        ActiveDocument.Bookmarks(vSt1).Select
        
    End Sub
    

    Now I can assign a keyboard shortcut to that macro to follow a reference.
    Sometime word looses all keyboard shortcuts (for no reason?) and thats why
    I also uses a macro to recreate these shortcuts (example for followReference()) :

        KeyBindings.Add wdKeyCategoryMacro, "followReference", BuildKeyCode(wdKeyHyphen, wdKeyShift)
    

    So be warned : the line above assigns [SHIFT]+[-] to that macro - u may use another combination!

    The big disadvantage of the macro is, that u can't goback and goforward with [ALT]+[<-] / [ALT]+[->].
    Because I do not know, how to manipulate the "click history" for those references, I decided to "bake"
    my own small solution for that.

    I use a simple array to save all visited "jumping marks" that were reached using followReference().
    Here is the complete solution :

    Const clng_MaxBM = 2047
    Public aoo_BookMarks(1 To clng_MaxBM) As String
    Public lng_bmPointer As Long
    Public lng_bmLastAdd As Long
    
    
    Public Sub renewHotKeys()
        KeyBindings.Add wdKeyCategoryMacro, "followReference", BuildKeyCode(wdKeyHyphen, wdKeyShift)
        KeyBindings.Add wdKeyCategoryMacro, "goBackBM", BuildKeyCode(&H26, wdKeyAlt)
        KeyBindings.Add wdKeyCategoryMacro, "goFwdBM", BuildKeyCode(&H28, wdKeyAlt)
    End Sub
    
    Public Sub CheckAddBM(aBm As String)
        If lng_bmLastAdd < clng_MaxBM Then
           lng_bmLastAdd = lng_bmLastAdd + 1
        Else
           lng_bmLastAdd = 1
        End If
        
        aoo_BookMarks(lng_bmLastAdd) = aBm
        lng_bmPointer = lng_bmLastAdd
    End Sub
    
    
    Public Sub gotoBM()
        Dim vSt1 As String
        
        If lng_bmPointer < 1 Or lng_bmPointer > lng_bmLastAdd Then
           Exit Sub
        End If
        
        vSt1 = aoo_BookMarks(lng_bmPointer)
        If vSt1 = "" Then
           Exit Sub
        End If
        
        If Left(vSt1, 1) = "F" Then
           ActiveDocument.Fields(Right(vSt1, Len(vSt1) - 1)).Select
        Else
           ActiveDocument.Bookmarks(vSt1).Select
        End If
    End Sub
    
    Public Sub goBackBM()
        Dim vSt1 As String
        
        If lng_bmPointer > 1 Then
           lng_bmPointer = lng_bmPointer - 1
        Else
           lng_bmPointer = lng_bmLastAdd
        End If
        
        gotoBM
    End Sub
    
    Public Sub goFwdBM()
        Dim vSt1 As String
        
        If lng_bmPointer < lng_bmLastAdd Then
           lng_bmPointer = lng_bmPointer + 1
        Else
           lng_bmPointer = 1
        End If
        
        gotoBM
    End Sub
    
    ' jumps to a cross referenced paragraph
    Public Sub followReference()
    
        Dim vSt0 As String
        Dim vSt1 As String
    
        On Error Resume Next
        Selection.Expand
    
        vSt0 = "F" & Selection.Fields(1).Index
        vSt1 = Selection.Fields(1).Code
        vSt1 = Split(vSt1, " ")(2)
        ActiveDocument.Bookmarks(vSt1).Select
        
        If Err = 0 Then
           CheckAddBM vSt0
           CheckAddBM vSt1
        End If
    
    End Sub
    

    I hope, I did not forget any lines ;-)

    So, with the solution above I can
    jump
    go back (with [Alt]+[^])
    go forward (with [Alt]+[v])
    by using the keyboard.

    But at this point (my) fun is not at the end...
    Think of a big douments with a lot of headers in differnt levels
    and u want to have a lot o fields to point to that headers...

    Because I also want to link a token by using the keyboard with
    the target header, I made macros therefore too.
    These macros will only work corrctly, if ur headers have no numbers etc.

    Headers are organized in a hierarchically system with a couple of levels, eg. 1,2,..,9.
    The levels I use mostly are 2-5. Here goes an example of what I want to do:

    my "word document" :

    bla bla bla
    text text text

    here goes a table with some tokens (e.g. "token1")

    |-------------|-------------|-------------|
    | Token1      |Token2       |Token3       |
    |_____________|_____________|_____________|

    bla bla bla text text text

    Token1  (this is a header of level 5)
    text text text text text text

    If I want to link the word "token1" to the header "token1",
    I can also use a macro. I only have to know the level of the header (this is easy to me).
    Here are the macros (for level 5)

    Function getCrossRefIndentForHeading(aGrade As Byte) As String
        Dim vIn1 As Integer
        
        vIn1 = aGrade * 2 - 2
        getCrossRefIndentForHeading = Space(vIn1)
    End Function
    
    Function findHeadingIndex(aTxt As String, aGrade As Byte) As Long
        Dim vSt0 As String
        Dim vAoO1
        Dim vIn0 As Integer
        Dim vIn1 As Integer
        Dim vIn2 As Integer
        Dim vIn3 As Integer
        Dim vAos1() As String
        Dim vSt1 As String
        
        vSt0 = getCrossRefIndentForHeading(aGrade) & LCase(aTxt)
        vAoO1 = ActiveDocument.GetCrossReferenceItems(WdReferenceType.wdRefTypeHeading)
        On Error Resume Next
        vIn2 = -1
        vIn2 = UBound(vAoO1)
        vIn0 = -1
        ReDim vAos1(1023)
        For vIn1 = 1 To vIn2
            If LCase(vAoO1(vIn1)) = vSt0 Then
               vIn0 = vIn0 + 1
               vAos1(vIn0) = vIn1
               findHeadingIndex = vIn1
            End If
        Next vIn1
        
        If vIn0 > 0 Then
           vSt1 = Join(vAos1, ", ")
           vAos1 = Split(vSt1, ", ", vIn0 + 2)
           vAos1(vIn0 + 1) = ""
           vSt1 = Join(vAos1, " ")
           vSt1 = Trim(InputBox("Index wählen!", "Mehrere Vorkommen gefunden....", vSt1))
           findHeadingIndex = Val(vSt1)
        ElseIf vIn0 = -1 Then
           MsgBox "Keine Entsprechung von '" & aTxt & "' vom Grad " & aGrade & " gefunden. Bitte erst erstellen!", vbExclamation, "Überschrift suchen..."
           findHeadingIndex = -2
        End If
        
    End Function
    
    Sub linkToH(aGrade As Byte)
        Dim vSt0 As String
        Dim vSt1 As String
        Dim vSt2 As String
        
        Dim vLo1 As Long
        Dim vIn1 As Integer
        Dim vLo2 As Long
        Dim vLo3 As Long
        Dim vBo1 As Boolean
        
        If Selection.Start = Selection.End Then
           Selection.Expand
           vSt0 = Selection.Text
        End If
        vSt0 = Selection.Text
        vSt1 = Trim(vSt0)
        
        vLo1 = findHeadingIndex(vSt1, aGrade)
        If vLo1 < 1 Then
           Exit Sub
        End If
        
        vIn1 = Selection.Font.Size
        vSt2 = Selection.Font.Name
        vBo1 = Selection.Font.Bold
        
        vLo2 = Selection.Start
        vLo3 = Selection.End
        
        
        Selection.InsertCrossReference WdReferenceType.wdRefTypeHeading, wdContentText, vLo1, True
        
        Selection.Start = vLo2
        Selection.End = vLo3
        
        Selection.Font.Size = vIn1
        Selection.Font.Name = vSt2
        Selection.Font.Bold = vBo1
        
        Selection.Start = Selection.End
        Selection.Text = Space(Len(vSt0) - Len(vSt1))
        
    End Sub
    
    Sub linkToH5()
        linkToH 5
    End Sub

    I have to excuse, some parts of the code are in german language.
    U may exchange the contents of that msgboxes in ur favorite language.

    Now I can assign another shortcut (e.g. [CONTROL]+[5]) to the macro "linkToH5()" :

        KeyBindings.Add wdKeyCategoryMacro, "linkToH5", BuildKeyCode(wdKey5, wdKeyControl)
    

    If you want to have shortcuts to other levels of headers, u can use the same "schema f" :

    Sub linkToH4()
        linkToH 4
    End Sub
    
    Sub linkToH3()
        linkToH 3
    End Sub
    
    Sub linkToH2()
        linkToH 2
    End Sub
    
    

    and of course the lines for the keyboard-recreation-macro

        KeyBindings.Add wdKeyCategoryMacro, "linkToH2", BuildKeyCode(wdKey2, wdKeyControl)
        KeyBindings.Add wdKeyCategoryMacro, "linkToH3", BuildKeyCode(wdKey3, wdKeyControl)
        KeyBindings.Add wdKeyCategoryMacro, "linkToH4", BuildKeyCode(wdKey4, wdKeyControl)
    

    Conclusion :

    After I wrote and used these macros I have a lot mor fun with my cross references.
    The fun would be even greater, I anybody could tell me, how to manipulate the "click history",
    then I would not need separate shortcuts for "my solution"....

    If you have (better) suggestions or found some bugs in my code then please post it :)

    Best regards
    dp.











    Friday, April 13, 2012 10:59 AM