|
|
| Author |
Message |
Misunderstud
1K Club
Joined: 10 Jan 2006
Posts: 1656
Location: Here, stupid
|
 Posted: Fri Sep 05, 2008 3:53 am Post subject: ----> Dogs: VBA stuff |
 |
|
Remember those macros you wrote for me? (Link)
Well, they do what it says on the tin, but I've also noticed that they remove formatting such as bold and italic from the notes. I wondered if you could spot any obvious reason why this should be so, and any easy way of preventing it? Don't worry if not, though.
Cheers. |
|
| Back to top |
|
 |
Dogs
1K Club
Joined: 17 May 2006
Posts: 1171
|
| Posted: Sat Sep 13, 2008 6:20 pm Post subject: |
|
|
How do these shape up?
| Code: | Sub FootnoteAfterParagraphFormatted()
'
' FootnoteAfterParagraphFormatted Macro
'
'
Dim afootnote As Footnote
Dim refrange As Range
Dim sectionno As Integer
Dim lastsectionno As Integer
Dim footnotecount As Integer
Dim paragraphno As Integer
Dim lastparagraphno As Integer
Dim paragraphcount As Integer
Dim footnoterange As Range
lastsectionno = 0
footnotecount = 0
lastparagraphno = 0
paragraphcount = 0
For Each afootnote In ActiveDocument.Footnotes
Set refrange = afootnote.Reference
refrange.Start = ActiveDocument.Range.Start
sectionno = refrange.Sections.Count
paragraphno = refrange.Paragraphs.Count
If sectionno > lastsectionno Then
lastsectionno = sectionno
footnotecount = 1
Else
footnotecount = footnotecount + 1
End If
If paragraphno = lastparagraphno Then
paragraphcount = paragraphcount + 1
Else
paragraphcount = 1
lastparagraphno = paragraphno
End If
For i = 1 To paragraphcount
refrange.End = refrange.End + 1
refrange.EndOf Unit:=wdParagraph, Extend:=wdExtend
Next i
Set footnoterange = afootnote.Range.FormattedText
footnoterange.Copy
refrange.InsertAfter "a" & footnotecount & "a "
refrange.Start = refrange.End
refrange.Paste
refrange.InsertAfter vbCr
afootnote.Reference.InsertBefore "a" & footnotecount & "a"
Next afootnote
For Each afootnote In ActiveDocument.Footnotes
afootnote.Reference.Delete
Next afootnote
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
End With
With Selection.Find
.Text = "(a)([0-9]{1,})(a)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
|
| Code: | Sub FootnoteAfterSectionFormatted()
'
' FootnoteAfterSectionFormatted Macro
'
'
Dim afootnote As Footnote
Dim refrange As Range
Dim sectionno As Integer
Dim lastsectionno As Integer
Dim footnotecount As Integer
Dim secrange As Range
Dim footnoterange As Range
lastsectionno = 0
footnotecount = 0
For Each afootnote In ActiveDocument.Footnotes
Set refrange = afootnote.Reference
refrange.Start = ActiveDocument.Range.Start
sectionno = refrange.Sections.Count
Set secrange = ActiveDocument.Sections(sectionno).Range
If sectionno > lastsectionno Then
lastsectionno = sectionno
footnotecount = 1
Else
footnotecount = footnotecount + 1
End If
For i = 1 To footnotecount
secrange.End = secrange.End - 1
Next i
Set footnoterange = afootnote.Range.FormattedText
footnoterange.Copy
secrange.InsertAfter vbCr & "a" & footnotecount & "a "
secrange.Start = secrange.End
secrange.Paste
secrange.InsertAfter vbCr
afootnote.Reference.InsertBefore "a" & footnotecount & "a"
Next afootnote
For Each afootnote In ActiveDocument.Footnotes
afootnote.Reference.Delete
Next afootnote
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
End With
With Selection.Find
.Text = "(a)([0-9]{1,})(a)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
|
| Code: | Sub FootnoteAfterEndFormatted()
'
' FootnoteAfterEndFormatted Macro
'
'
Dim afootnote As Footnote
Dim refrange As Range
Dim sectionno As Integer
Dim lastsectionno As Integer
Dim footnotecount As Integer
Dim footnoterange As Range
Dim docrange As Range
lastsectionno = 0
footnotecount = 0
For Each afootnote In ActiveDocument.Footnotes
Set refrange = afootnote.Reference
refrange.Start = ActiveDocument.Range.Start
sectionno = refrange.Sections.Count
If sectionno > lastsectionno Then
lastsectionno = sectionno
footnotecount = 1
Else
footnotecount = footnotecount + 1
End If
Set footnoterange = afootnote.Range
footnoterange.Copy
ActiveDocument.Range.InsertAfter vbCr & "a" & footnotecount & "a "
Set docrange = ActiveDocument.Range
docrange.Start = docrange.End
docrange.Paste
afootnote.Reference.InsertBefore "a" & footnotecount & "a"
Next afootnote
For Each afootnote In ActiveDocument.Footnotes
afootnote.Reference.Delete
Next afootnote
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
End With
With Selection.Find
.Text = "(a)([0-9]{1,})(a)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
|
One question - are there any types of formatting other than bold and italic? |
|
| Back to top |
|
|
Misunderstud
1K Club
Joined: 10 Jan 2006
Posts: 1656
Location: Here, stupid
|
| Posted: Sun Sep 14, 2008 12:12 pm Post subject: |
|
|
They seem to work fine. Thanks.
There are other formattings, yes: bold, underlined, italic-underlined, bold-underlined, bold-italic and bold-italic-underlined would cover most of the bases. But the doc I tested had all those and all were preserved, so that doesn't appear to be a concern.
The other situation I need to address is that of simply unlinking existing endnotes from the text without losing formatting. You'll recall there was code for that in the original post, so maybe that could be similarly modified?
Finally, also as previously, a second set that do the same thing but replace the superscript numbers preceding each note with a normal-sized number followed by a full stop and a space would complete the picture . . .
. . . if you don't have anything more pressing to do  |
|
| Back to top |
|
|
Dogs
1K Club
Joined: 17 May 2006
Posts: 1171
|
| Posted: Sun Sep 14, 2008 1:23 pm Post subject: |
|
|
I asked about the formatting as I found a funny where it is preserved in the original text, but if that ended with a formatted word, then the next number took on that same format. So if the first one read:
1. test ending in bold
then the next one looked like this:
2. another test.
(that number 2 is in bold)
To iron it out, I needed to include something to not format the numbers. It's currently the bit that reads:
| Code: | With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
End With |
You should add in Underline:
| Code: | With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
.Underline = False
End With |
|
|
| Back to top |
|
|
Dogs
1K Club
Joined: 17 May 2006
Posts: 1171
|
| Posted: Sun Sep 14, 2008 1:31 pm Post subject: |
|
|
Modified without superscript:
| Code: | Sub FootnoteAfterEndFormattedReg()
'
' FootnoteAfterEndFormattedReg Macro
'
'
Dim afootnote As Footnote
Dim refrange As Range
Dim sectionno As Integer
Dim lastsectionno As Integer
Dim footnotecount As Integer
Dim footnoterange As Range
Dim docrange As Range
lastsectionno = 0
footnotecount = 0
For Each afootnote In ActiveDocument.Footnotes
Set refrange = afootnote.Reference
refrange.Start = ActiveDocument.Range.Start
sectionno = refrange.Sections.Count
If sectionno > lastsectionno Then
lastsectionno = sectionno
footnotecount = 1
Else
footnotecount = footnotecount + 1
End If
Set footnoterange = afootnote.Range
footnoterange.Copy
ActiveDocument.Range.InsertAfter vbCr & "b" & footnotecount & "b. "
Set docrange = ActiveDocument.Range
docrange.Start = docrange.End
docrange.Paste
afootnote.Reference.InsertBefore "a" & footnotecount & "a"
Next afootnote
For Each afootnote In ActiveDocument.Footnotes
afootnote.Reference.Delete
Next afootnote
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
.Underline = False
End With
With Selection.Find
.Text = "(a)([0-9]{1,})(a)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = False
.bold = False
.Italic = False
.Underline = False
End With
With Selection.Find
.Text = "(b)([0-9]{1,})(b)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
|
| Code: | Sub FootnoteAfterSectionFormattedReg()
'
' FootnoteAfterSectionFormattedReg Macro
'
'
Dim afootnote As Footnote
Dim refrange As Range
Dim sectionno As Integer
Dim lastsectionno As Integer
Dim footnotecount As Integer
Dim secrange As Range
Dim footnoterange As Range
lastsectionno = 0
footnotecount = 0
For Each afootnote In ActiveDocument.Footnotes
Set refrange = afootnote.Reference
refrange.Start = ActiveDocument.Range.Start
sectionno = refrange.Sections.Count
Set secrange = ActiveDocument.Sections(sectionno).Range
If sectionno > lastsectionno Then
lastsectionno = sectionno
footnotecount = 1
Else
footnotecount = footnotecount + 1
End If
For i = 1 To footnotecount
secrange.End = secrange.End - 1
Next i
Set footnoterange = afootnote.Range.FormattedText
footnoterange.Copy
secrange.InsertAfter vbCr & "b" & footnotecount & "b. "
secrange.Start = secrange.End
secrange.Paste
secrange.InsertAfter vbCr
afootnote.Reference.InsertBefore "a" & footnotecount & "a"
Next afootnote
For Each afootnote In ActiveDocument.Footnotes
afootnote.Reference.Delete
Next afootnote
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
.Underline = False
End With
With Selection.Find
.Text = "(a)([0-9]{1,})(a)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = False
.bold = False
.Italic = False
.Underline = False
End With
With Selection.Find
.Text = "(b)([0-9]{1,})(b)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
|
| Code: | Sub FootnoteAfterParagraphFormattedReg()
'
' FootnoteAfterParagraphFormattedReg Macro
'
'
Dim afootnote As Footnote
Dim refrange As Range
Dim sectionno As Integer
Dim lastsectionno As Integer
Dim footnotecount As Integer
Dim paragraphno As Integer
Dim lastparagraphno As Integer
Dim paragraphcount As Integer
Dim footnoterange As Range
lastsectionno = 0
footnotecount = 0
lastparagraphno = 0
paragraphcount = 0
For Each afootnote In ActiveDocument.Footnotes
Set refrange = afootnote.Reference
refrange.Start = ActiveDocument.Range.Start
sectionno = refrange.Sections.Count
paragraphno = refrange.Paragraphs.Count
If sectionno > lastsectionno Then
lastsectionno = sectionno
footnotecount = 1
Else
footnotecount = footnotecount + 1
End If
If paragraphno = lastparagraphno Then
paragraphcount = paragraphcount + 1
Else
paragraphcount = 1
lastparagraphno = paragraphno
End If
For i = 1 To paragraphcount
refrange.End = refrange.End + 1
refrange.EndOf Unit:=wdParagraph, Extend:=wdExtend
Next i
Set footnoterange = afootnote.Range.FormattedText
footnoterange.Copy
refrange.InsertAfter "b" & footnotecount & "b. "
refrange.Start = refrange.End
refrange.Paste
refrange.InsertAfter vbCr
afootnote.Reference.InsertBefore "a" & footnotecount & "a"
Next afootnote
For Each afootnote In ActiveDocument.Footnotes
afootnote.Reference.Delete
Next afootnote
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
.Underline = False
End With
With Selection.Find
.Text = "(a)([0-9]{1,})(a)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = False
.bold = False
.Italic = False
.Underline = False
End With
With Selection.Find
.Text = "(b)([0-9]{1,})(b)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
|
|
|
| Back to top |
|
|
Dogs
1K Club
Joined: 17 May 2006
Posts: 1171
|
| Posted: Sun Sep 14, 2008 1:35 pm Post subject: |
|
|
Endnote (did I modify the right script?)
| Code: | Sub EndnoteFormatted()
'
' EndnoteFormatted Macro
'
'
Dim aendnote As Endnote
Dim refrange As Range
Dim sectionno As Integer
Dim lastsectionno As Integer
Dim endnotecount As Integer
Dim endnoterange As Range
Dim docrange As Range
lastsectionno = 0
endnotecount = 0
For Each aendnote In ActiveDocument.Endnotes
Set refrange = aendnote.Reference
refrange.Start = ActiveDocument.Range.Start
sectionno = refrange.Sections.Count
Set endnoterange = aendnote.Range.FormattedText
endnoterange.Copy
If sectionno > lastsectionno Then
lastsectionno = sectionno
endnotecount = 1
Else
endnotecount = endnotecount + 1
End If
ActiveDocument.Range.InsertAfter vbCr & "b" & endnotecount & "b. "
Set docrange = ActiveDocument.Range
docrange.Start = docrange.End
docrange.Paste
aendnote.Reference.InsertBefore "a" & endnotecount & "a"
Next aendnote
For Each aendnote In ActiveDocument.Endnotes
aendnote.Reference.Delete
Next aendnote
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = True
.bold = False
.Italic = False
.Underline = False
End With
With Selection.Find
.Text = "(a)([0-9]{1,})(a)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = False
.bold = False
.Italic = False
.Underline = False
End With
With Selection.Find
.Text = "(b)([0-9]{1,})(b)"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
|
|
|
| Back to top |
|
|
Misunderstud
1K Club
Joined: 10 Jan 2006
Posts: 1656
Location: Here, stupid
|
| Posted: Mon Sep 15, 2008 3:58 am Post subject: |
|
|
Yep, all good. The only glitch I found (in all of them) was that if a note contains one or more hard returns then everything before the final hard return is formatted as footnote text rather than body text. (It still gets moved to the right place and the other formatting is preserved - it just comes up small.)
Not a major concern, though, since I run the macro before editing the text. |
|
| Back to top |
|
|
Dogs
1K Club
Joined: 17 May 2006
Posts: 1171
|
| Posted: Mon Sep 15, 2008 9:49 am Post subject: |
|
|
Are you able to format footnote text as body text across the document before you start? I assume the only real difference is font size.
The only way I could find to retain the formatting was to copy and paste the original text, so it's not too surprising if it retains qualities such as size. I'm not sure how I'd get around that. |
|
| Back to top |
|
|
Misunderstud
1K Club
Joined: 10 Jan 2006
Posts: 1656
Location: Here, stupid
|
| Posted: Mon Sep 15, 2008 10:31 am Post subject: |
|
|
| Dogs wrote: | | Are you able to format footnote text as body text across the document before you start? I assume the only real difference is font size. |
Yes, that would be simple enough to do. The way round it would be to send the cursor to the first footnote (or endnote), select all the text from there to the end and apply a style. I was trying to do something similar in the workarounds I PM'd you about but, although I could do it with the document open, I couldn't make the macro I recorded while doing it work.
Not to worry, though; these will do just fine. Thanks again. |
|
| Back to top |
|
|
|
