Sub 脚注转换() Dim myRange As Range, NtRange As Range, strNT As String Application.ScreenUpdating = False Set myRange = ActiveDocument.Content NF: With myRange.Find .Text = "〖*〗" .MatchWildcards = True Do While .Execute = True Set NtRange = ActiveDocument.Range(myRange.Start, myRange.Start) strNT = myRange.Text myRange.Delete ActiveDocument.Footnotes.Add NtRange, , strNT myRange.SetRange myRange.End, ActiveDocument.Content.End - 1 GoTo NF Loop End With Application.ScreenUpdating = True End Sub