Transfer text to footnotes

thiagoafdoria · #1 02-12-2017, 06:16 PM

Hi!
I'm using a macro to transform every bit of green text in a document into footnotes. A person within the community of a software I use kindly shared the code to this macro. It's the followin one:

Quote:

Sub Makro8()
'
' Makro8 Makro

' Macro for MS Word converting parts of text in a special color (here: green)
' into MS Word footnotes
'
Do While Not ActiveDocument.Range.End - 1 = Selection.Range.End
Selection.Find.ClearFormatting
With Selection.Find
.Font.Color = wdColorGreen
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection.Font
.Color = wdColorAutomatic
End With
If Selection.Type = wdSelectionIP Then
If ActiveWindow.ActivePane.View.Type = wdPrintView Or ActiveWindow. _
ActivePane.View.Type = wdWebView Or ActiveWindow.ActivePane.View.Type = _
wdPrintPreview Then
ActiveWindow.View.SeekView = wdSeekFootnotes
Else
ActiveWindow.View.SplitSpecial = wdPaneFootnotes
End If
Exit Sub
End If
Selection.Cut
With ActiveDocument.Range(Start:=ActiveDocument.Content .Start, End:= _
ActiveDocument.Content.End)
With .FootnoteOptions
.Location = wdBottomOfPage
.NumberingRule = wdRestartContinuous
.StartingNumber = 1
.NumberStyle = wdNoteNumberStyleArabic
End With
.Footnotes.Add Range:=Selection.Range, Reference:=""
End With
Selection.PasteAndFormat (wdPasteDefault)
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
ActiveWindow.ActivePane.Close
Loop
End Sub

The problem is, it transforms one part of the green text at a time. If I have 46 pieces of green text, I'd have to execute the macro 46 times. Do you have any idea of what I could modify in order to execute the macro only one time?
I'm running a Microsoft Word 2016 (Office 365) in Windows 8.1. Please note that the macro is working; it just doesn't transform the several pieces into footnotes all at once.
Best regards,
Thiago

macropod · #2 02-12-2017, 09:01 PM

For a much more efficient macro, try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, FtNt As Footnote
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Format = True
    .Font.ColorIndex = wdGreen
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    Set Rng = .Duplicate
    .Collapse wdCollapseStart
    Set FtNt = .Footnotes.Add(.Duplicate)
    Rng.Start = FtNt.Reference.End
    FtNt.Range.FormattedText = Rng.FormattedText
    Rng.Delete
    If .End = ActiveDocument.Range.End Then Exit Sub
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

thiagoafdoria · #3 02-13-2017, 11:23 AM

Thank you!
I've tried, but unfortunately the file keeps loading while the macro runs endlessly. Could it be because I'm running Microsoft Word 2016 (Office 365)?

PS: I've just replaced the old code for this new one. I don't know if I should do something else. I've just opened the Macro dialog window and then I've clicked "edit"; so I was able to do the replacement.

macropod · #4 02-14-2017, 03:56 AM

I don't understand your 'the file keeps loading while the macro runs endlessly' comment. The macro doesn't load any files. All it does is find all green text in the active document and convert that text to footnotes. The Word version is of no consequence

thiagoafdoria · #5 02-14-2017, 04:21 AM

Sorry, I didn't express myself correctly. I mean I run the macro, but instead of converting all the green text into footnotes, MS Word begins to not respond anymore (this is what I meant by "the macro runs endlessly"). It crashes, so to speak.

macropod · #6 02-14-2017, 04:25 AM

I am unable to reproduce that behaviour, regardless of where the content might be in the document body.

Can you attach the problem document to a post (delete/obfuscate anything sensitive)?

thiagoafdoria · #7 02-14-2017, 07:34 AM

Sure!

I'm attaching the file I was using as a test. Now it seems that when I run the macro nothing happens.

I'm pretending to edit a large document (probably 30k words). I also don't know if the amount of words would matter in this case.

thiagoafdoria · #8 02-14-2017, 09:51 AM

I've just realized that I've used a different shade of green in the document I've previously attached. That's the reason why nothing has happened when I tried to run the macro.
Now I'm sending the same document, but with the appropriate green color. Now you'll see the behavior I've mentioned early: you run the macro and the MS Word stops responding.
Thank's in advance,
Thiago

macropod · #9 02-14-2017, 01:54 PM

The problem with your document is that it has trailing spaces & paragraph breaks formatted green. The following code revision will take care of that (plus tabs & line breaks):

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, FtNt As Footnote
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Format = True
    .Font.ColorIndex = wdGreen
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .Characters.Last Like "[" & vbCr & vbTab & Chr(11) & Chr(160) & " ]" Then
      .Characters.Last.Font.Reset
      .End = .End - 1
    End If
    Set Rng = .Duplicate
    .Collapse wdCollapseStart
    Set FtNt = .Footnotes.Add(.Duplicate)
    Rng.Start = FtNt.Reference.End
    FtNt.Range.FormattedText = Rng.FormattedText
    Rng.Delete
    If .End = ActiveDocument.Range.End Then Exit Sub
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

thiagoafdoria · #10 02-15-2017, 06:54 AM

Wow! This is truly amazing! It works perfectly. Thank you very much!

thiagoafdoria · #11 05-13-2019, 07:47 PM

Hi there!
Sorry for taking back an old thread. The macro below transforms text in green color into footnotes.

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, FtNt As Footnote
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Format = True
    .Font.ColorIndex = wdGreen
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .Characters.Last Like "[" & vbCr & vbTab & Chr(11) & Chr(160) & " ]" Then
      .Characters.Last.Font.Reset
      .End = .End - 1
    End If
    Set Rng = .Duplicate
    .Collapse wdCollapseStart
    Set FtNt = .Footnotes.Add(.Duplicate)
    Rng.Start = FtNt.Reference.End
    FtNt.Range.FormattedText = Rng.FormattedText
    Rng.Delete
    If .End = ActiveDocument.Range.End Then Exit Sub
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

I would like to change it, so that the footnotes are made from fragments between "[!" and "!]", not green text anymore. For example:

This is normal text.[!This should be turned into a footnote.!] This is normal text. This is normal text... And so on.

Is that possible?

Thank's in advance,

Thiago

macropod · #12 05-13-2019, 07:54 PM

Change:

Code:

    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Format = True
    .Font.ColorIndex = wdGreen

to:

Code:

    .Text = "\[\!*\!\]"
    .Replacement.Text = ""
    .Forward = True
    .Format = False

thiagoafdoria · #13 05-14-2019, 06:37 PM

Fantastic! Thank you very much!
If it's not too much trouble: would there also be a macro to do just the opposite (turn footnotes into delimited fragments between "[!" and "!]" in the body of the text)?

macropod · #14 05-14-2019, 07:28 PM

Simple:

Code:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument
  Do While .Footnotes.Count > 0
    With .Footnotes(1)
      .Reference.InsertAfter "[!" & .Range.FormattedText & "!]"
      .Delete
    End With
  Loop
End With
Application.ScreenUpdating = True
End Sub

thiagoafdoria · #15 05-22-2019, 08:37 AM

macropod, thank you very very much! And sorry for the late reply.
Thiago

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to change superscript footnotes into genuine Word footnotes	Knounte29	Word VBA	41	01-16-2020 04:48 PM
Help with Tracking: Bold in body text, but not in Footnotes	Bobbety	Word	3	05-17-2015 11:17 PM
word 2007 - footnotes and text box	glggluig	Word	1	08-10-2014 04:09 AM
All my footnotes turned to blue underlined text.	bww	Word	0	07-11-2013 08:35 AM
create footnotes from custom text	mosrozen	Word VBA	2	06-14-2012 06:59 AM