Sub 快速提取脚注内容()
Dim oFootNote As Footnote, myRange As Range
Dim BeforeName As String, BeforeSize As Single
On Error Resume Next
Application.ScreenUpdating = False
For Each oFootNote In ActiveDocument.Footnotes
With oFootNote
Set myRange = ActiveDocument.Range(.Reference.Start, .Reference.End)
.Range.Copy
With myRange
.Text = "〖〗"
BeforeName = .Font.Name
BeforeSize = .Font.Size
myRange.SetRange .Start + 1, .Start + 1
.Paste
.Font.Name = BeforeName
.Font.Size = BeforeSize
End With
End With
Next
Application.ScreenUpdating = True
End Sub
