Re linking footnotes 1

[MarcusStringer]

Hi people,
I was wondering if you could help me or point me in the right direction?

I have a series of word files which were made from Quark, and it strips out the footnote linking.

It puts all the footnotes at the end of the Document (like Endnotes) and the number in the text is just a subscript number (with no link)

I've included the following macro which will do the first one just the way I want it to i.e.
Find the first footnote, cut it from the document, find the the first subscript number in the document then create a footnote and paste the old one I just cut into it.

I can't workout where to put the loop

Sub ReLinkingFootNotes()
'
' ReLinkingFootNotes Macro
' Macro recorded 9/23/05 by marcus
'
 Dim i As Integer
 
 i = 1

Selection.HomeKey wdStory
With Selection.Find
  Selection.Find.ClearFormatting
    With Selection.Find
        .Text = i & " ^t"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
Selection.Find.Execute
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Cut
    Selection.Find.ClearFormatting
    
    
 
   With Selection.Find.Font
        .Superscript = True
  
    
    With Selection.Find
        .Text = "1"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    ActiveDocument.Footnotes.Add Range:=Selection.Range, Reference:=""
    Selection.Paste

i = i + 1
End With
End With
End Sub

Any help would be god send

Marcus

http://www.midlandtypesetters.com.au

 

[macropod]

Hi Marcus,

Try something like:

Sub ReLinkingFootNotes()
Dim i As Integer
Dim j As Integer
Dim FootnoteArray(512) As String
With Selection
    j = 0
    For i = 1 To .Paragraphs.Count
        If Asc(Mid(.Paragraphs(i).Range.Text, 1, 1)) > 47 And _
        Asc(Mid(.Paragraphs(i).Range.Text, 1, 1)) < 58 Then
            If Int(Mid(.Paragraphs(i).Range.Text, 1, Len(j))) = j + 1 Then
                j = j + 1
                FootnoteArray(j) = Mid(.Paragraphs(i).Range.Text, 1, Len(.Paragraphs(i).Range.Text) - 1)
            Else
                FootnoteArray(j) = FootnoteArray(j) & vbCrLf & _
                Mid(.Paragraphs(i).Range.Text, 1, Len(.Paragraphs(i).Range.Text) - 1)
            End If
        Else
            FootnoteArray(j) = FootnoteArray(j) & vbCrLf & _
            Mid(.Paragraphs(i).Range.Text, 1, Len(.Paragraphs(i).Range.Text) - 1)
        End If
    Next i
    .Delete
End With
For i = 1 To j
ActiveDocument.Select
    With Selection.Find
    .Forward = True
    .Font.Superscript = True
    .Text = i
    .MatchWholeWord = True
    .Execute
    If .Found = True Then
    .Parent.Select
        With Selection
            .Delete
            .Footnotes.Add Range:=Selection.Range, Text:=FootnoteArray(i)
        End With
    End If
    End With
Next i
End Sub

The first loop goes through your *selection* of footnotes, looking for paragraphs beginning with numbers and, if it finds one that is the next consecutive number, adds the paragraph to a new array item. Otherwise it adds the paragraph to the current array item. This is to allow for multi-paragraph footnotes that might even start with a number.

After building the array, the code deletes the old footnotes (you may want to comment out the '.Delete')

The second loop goes through the document looking for superscripted numbers to append the footnotes to. when it finds one, it adds the corresponding footnote from the array. No checking is done for duplicated footnotes - I don't know if Quark allows them, but Word doesn't. The code only adds the footnote to the first instance, so the second instance will still refer to the same footnote. You may want to replace the second instance with a cross-reference so that the duplicate footnote references will update correctly if you edit the document.

Finally, I made the FootnoteArray Array large enough to hold 512 footnotes - if that's not enough(!), you can increase the size of the array to suit.


Cheers

 

[fumei]

Nice.

Gerry

 

[MarcusStringer]

Hi again,
Thanks for all your help.
Except, all it does is delete the letter next to where ever the curser is???

Um I guess I should mention it's OSX word 2001 through classic.


Marcus

http://www.midlandtypesetters.com.au

 

[macropod]

Hi Marcus,

Works fine for me with Word 2000 on a PC. Unless there's something odd about vba for the Mac, I would have thought it would work there too.

Did you *select* the whole of the footnote paras that you wanted to convert?

Cheers

 

[MarcusStringer]

Oh...Select...now it works.
Thanks for everything, you have just saved me sooo much time.

Marcus

http://www.midlandtypesetters.com.au

 

[MarcusStringer]

It works great until it gets to Footnote 10, then it skips it and moves on until....
Out of 207 footnotes it skips numbers
10,25,60,70,78,89,91,92 then when it gets to 99 it puts the remaining ones together

Any thoughts??



Marcus

http://www.midlandtypesetters.com.au

 

[macropod]

Hi Marcus,

If you change the line:
If Int(Mid(.Paragraphs(i).Range.Text, 1, Len(j))) = j + 1 Then
to
If Int(Mid(.Paragraphs(i).Range.Text, 1, Len(j + 1))) = j + 1 Then
that should deal with the transition from units to tens, tens to hundreds, etc. It may also fix some of the other problems.

With 25,60,70,78,89,91,92, etc, are you sure none of them is preceding by a space or a tab?

Cheers

 

[MarcusStringer]

Sorry,
I feel so stupid,
It now says

"Compile error:
Variable required - Can't assign to this expression"

This is what it looks like now.

Sub ReLinkingFootNotes()
Dim i As Integer
Dim j As Integer
Dim FootnoteArray(999) As String
With Selection
    j = 0
    For i = 1 To .Paragraphs.Count
        If Asc(Mid(.Paragraphs(i).Range.Text, 1, 1)) > 47 And _
        Asc(Mid(.Paragraphs(i).Range.Text, 1, 1)) < 58 Then
            If Int(Mid(.Paragraphs(i).Range.Text, 1, Len(j + 1))) = j + 1 Then
                j = j + 1
                FootnoteArray(j) = Mid(.Paragraphs(i).Range.Text, 1, Len(.Paragraphs(i).Range.Text) - 1)
            Else
                FootnoteArray(j) = FootnoteArray(j) & vbCrLf & _
                Mid(.Paragraphs(i).Range.Text, 1, Len(.Paragraphs(i).Range.Text) - 1)
            End If
        Else
            FootnoteArray(j) = FootnoteArray(j) & vbCrLf & _
            Mid(.Paragraphs(i).Range.Text, 1, Len(.Paragraphs(i).Range.Text) - 1)
        End If
    Next i
 '   .Delete
End With
For i = 1 To j
ActiveDocument.Select
    With Selection.Find
    .Forward = True
    .Font.Superscript = True
    .Text = i
    .MatchWholeWord = True
    .Execute
    If .Found = True Then
    .Parent.Select
        With Selection
            .Delete
            .Footnotes.Add Range:=Selection.Range, Text:=FootnoteArray(i)
        End With
    End If
    End With
Next i
End Sub

Thanks for you help


Marcus

http://www.midlandtypesetters.com.au

 

[macropod]

Hi Marcus,

New & improved code attached. The new version removes the 'text' numbers from the footnotes also.

Part of the problem was that I was trying to use the length of the integer j for testing, but in vba this is always 2, regarless of whether j = 1, 10, 100, etc.

Sub ReLinkFootNotes()
Dim i As Integer
Dim j As Integer
Dim k As String
Dim FootnoteArray(512) As String
With Selection
    j = 0
    For i = 1 To .Paragraphs.Count
        If Asc(Mid(.Paragraphs(i).Range.Text, 1, 1)) > 47 And _
        Asc(Mid(.Paragraphs(i).Range.Text, 1, 1)) < 58 Then
            k = j + 1
            If Mid(.Paragraphs(i).Range.Text, 1, Len(k)) = k Then
                j = j + 1
                FootnoteArray(j) = Right(.Paragraphs(i).Range.Text, _
                Len(.Paragraphs(i).Range.Text) - Len(k))
            Else
                FootnoteArray(j) = FootnoteArray(j) & .Paragraphs(i).Range.Text
            End If
        Else
            FootnoteArray(j) = FootnoteArray(j) & .Paragraphs(i).Range.Text
        End If
    Next i
    .Delete
End With
For i = 1 To j
ActiveDocument.Select
    With Selection.Find
    .Forward = True
    .Font.Superscript = True
    .Text = i
    .MatchWholeWord = True
    .Execute
    If .Found = True Then
    .Parent.Select
        With Selection
            .Delete
            .Footnotes.Add Range:=Selection.Range, Text:=Left(FootnoteArray(i), Len(FootnoteArray(i)) - 1)
        End With
    End If
    End With
Next i
End Sub

Cheers

 

[MarcusStringer]

Sorry mate.

But it doesn't do anything.
I selected the footnotes
ran the macro, and nothing happens. Oh, I had to comment out the .Delete in middle because all it did was delete my selection.

Thanks

Marcus

http://www.midlandtypesetters.com.au

 

[macropod]

Hi Marcus,

It works for me. I don't understand why it wouldn't work for you.

I'm assuming you're not running the code on a document that has already been partly converted, and that the first footnote to convert is number 1. If not, you'll need to change the line:
j = 0
to
j = InputBox("Please input the first footnote number") - 1
Then select the range of consectively-numbered footnotes to convert and run the macro - it will ask you to input the first footnote number.

Cheers

 

[MarcusStringer]

You, my friend, are a ledgend.

It works but only on a PC.

Which I should have checked yesterday, save you going through all that hastle.

In our sea of Mac's we only have one PC, This will now become our community Computer for Macros.

Once again thanks.


Marcus

http://www.midlandtypesetters.com.au

 

[MarcusStringer]

Hi Macropod,
It works, but it still skips numbers:
10,20,25,60,78,89,91,92,100,109,110,152,177,197,199,201.

Could you please email me from the email address on this link:

http://www.midlandtypesetters.com.au/contactus.asp

and perhaps I could send you the word file so you know what I'm on about?

Sorry to be a pest


Marcus

http://www.midlandtypesetters.com.au

 

[macropod]

Hi Marcus,

The fix is as simple as changing:
.MatchWholeWord = True
to:
.MatchWholeWord = False

Below is a streamlined version of the code. However, I've found that even this doesn't preserve the italics etc that were in the original footnotes. Although Word has a formattedtext property, I haven't been able to get it to work with this code. Accordingly, I've comment out the '.Delete', as you'll need to correct the italics after the code has executed. Maybe someone else can help with the coding for that.

Sub ReLinkFootNotes()
Dim i As Integer
Dim j As Integer
Dim k As String
Dim FootnoteArray(512)
With Selection
    j = 0
    For i = 1 To .Paragraphs.Count
        If .Paragraphs(i).Range.Words(1) = j + 1 Then
            j = j + 1
            k = j
            FootnoteArray(j) = Right(.Paragraphs(i).Range, _
            Len(.Paragraphs(i).Range.Text) - Len(k))
        Else
            FootnoteArray(j) = FootnoteArray(j) & .Paragraphs(i).Range
        End If
    Next i
    '.Delete
End With
For i = 1 To j
ActiveDocument.Select
    With Selection.Find
    .Forward = True
    .Font.Superscript = True
    .Text = i
    .MatchWholeWord = False
    .Execute
    If .Found = True Then
    .Parent.Select
        With Selection
            .Delete
            .Footnotes.Add Range:=Selection.Range, Text:=Trim(Left(FootnoteArray(i), Len(FootnoteArray(i)) - 1))
        End With
    End If
    End With
Next i
End Sub

Cheers

 

[macropod]

Hi Marcus,

Below is a re-worked macro that appears to correctly process your footnotes *and* retain their formatting. The macro is also coded to show its progress on the status bar.

I've tested the code and it seems to produce the correct result, though I'm not sure which style you're using for footnotes. If I've picked the wrong name, you can simply change it in the line:
.Style = "Footnote Text"

The other important point to note is that, as coded, the macro only works with single-paragraph footnotes. If you have any multi-paragraph footnotes, you can get around that issue by changing their internal paragraph markers to line feeds (ie Shift-Enter).

Sub ReLinkFootNotes2()
Dim i As Integer
Dim j As Integer
Application.ScreenUpdating = False
With Selection
    .Bookmarks.Add Range:=Selection.Range, Name:="FootNotes"
    j = 0
    For i = 1 To .Paragraphs.Count
        If .Paragraphs(i).Range.Words(1) = j + 1 Then
            j = j + 1
        End If
    Next i
End With
For i = 1 To j
StatusBar = "Finding Footnote Location: " & i
ActiveDocument.Select
    With Selection.Find
    .Forward = True
    .Font.Superscript = True
    .Text = i
    .MatchWholeWord = False
    .Execute
    If .Found = True Then
    .Parent.Select
        With Selection
            .Delete
            .Footnotes.Add Range:=Selection.Range, Text:=""
        End With
    End If
    End With
Next i
With ActiveDocument.Bookmarks("FootNotes").Range
    For i = 1 To j
        StatusBar = "Transferring Footnote: " & i
        With .Paragraphs(1).Range
            .Cut
            With ActiveDocument.Footnotes(i).Range
                .Paste
                .Words(1).Delete
                .Characters(.Characters.Count).Delete
                .Style = "Footnote Text"
            End With
        End With
    Next i
    On Error Resume Next
    .Bookmarks("FootNotes").Delete
End With
Application.ScreenUpdating = True
End Sub

How the code works:
. Take the selected range of footnotes and bookmark them.
. Count the number of bookmarked paragraphs with sequential numbers
. Find the corresponding superscripted sequential numbers in the document
. Turn matched superscripted sequential numbers into empty footnotes
. Cut the bookmarked footnote paragraphs and paste them into the empty footnotes
. Delete the first word (footnote number) and last character (duplicate para mark) from each footnote and apply the footnote style.
. Delete the bookmark

Cheers