rgsl111
10-26-2021, 12:19 PM
I've been working on piecing together a program thanks to a high school VBA class years ago and searching this site that, among other things, takes an "outside" document, pastes it as unformatted text into a blank template, and runs through a number of mostly find/replace functions. Problem is that it doesn't bring over footnotes. I was able to get it to insert the in-paragraph footnote marks and currently have it pasting the content of the footnotes at the end of the document to be manually placed, but I'm trying to be able to get it to insert the content into its corresponding footnote, but it is a good bit above my ability (and a good bit of this is probably fairly inefficient, but I don't get any errors, so I don't question it). Any help would be greatly appreciated!
Here is what is have so far:
Private Sub CommandButton1_Click()
With ActiveDocument
.AutoHyphenation = False
With .Range
With .Find
Dim xRange As Range
Set xDoc = ActiveDocument
If xDoc.Footnotes.Count > 0 Then
Set xRange = xDoc.Footnotes(1).Range
xRange.WholeStory
xRange.Select
ActiveDocument.Paragraphs.Add
ActiveDocument.Content.InsertAfter "Footnotes"
ActiveDocument.Paragraphs.Add
Selection.Copy
Set Range2 = ActiveDocument.Content
Range2.Collapse Direction:=wdCollapseEnd
Range2.Paste
.Text = "^f"
.Replacement.Text = "<footnote>"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Replacement.ClearFormatting
.Format = True
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Font.Underline = True
End If
End With
End With
Dim wholeDoc As Document
Dim wholeRange As Range
Set wholeDoc = ActiveDocument
Set wholeRange = wholeDoc.Range(Start:=0, End:=0)
wholeRange.WholeStory
wholeRange.Select
Selection.Copy
End With
Documents.Add ("12pt Template")
With ActiveDocument
Set myRange = Selection.Range
myRange.WholeStory
Selection.PasteSpecial DataType:=wdPasteText
EmphasisFormatClean
WPDFormat
End With
Unload Me
End Sub
Thank you!
Here is what is have so far:
Private Sub CommandButton1_Click()
With ActiveDocument
.AutoHyphenation = False
With .Range
With .Find
Dim xRange As Range
Set xDoc = ActiveDocument
If xDoc.Footnotes.Count > 0 Then
Set xRange = xDoc.Footnotes(1).Range
xRange.WholeStory
xRange.Select
ActiveDocument.Paragraphs.Add
ActiveDocument.Content.InsertAfter "Footnotes"
ActiveDocument.Paragraphs.Add
Selection.Copy
Set Range2 = ActiveDocument.Content
Range2.Collapse Direction:=wdCollapseEnd
Range2.Paste
.Text = "^f"
.Replacement.Text = "<footnote>"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Replacement.ClearFormatting
.Format = True
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Font.Underline = True
End If
End With
End With
Dim wholeDoc As Document
Dim wholeRange As Range
Set wholeDoc = ActiveDocument
Set wholeRange = wholeDoc.Range(Start:=0, End:=0)
wholeRange.WholeStory
wholeRange.Select
Selection.Copy
End With
Documents.Add ("12pt Template")
With ActiveDocument
Set myRange = Selection.Range
myRange.WholeStory
Selection.PasteSpecial DataType:=wdPasteText
EmphasisFormatClean
WPDFormat
End With
Unload Me
End Sub
Thank you!