请教如何将Word正文中的注释批量转为脚注

共享精神

Word文档正文中有多个注释，其中的注文都使用【】表示。请教如何将所有这些注释同时转换为脚注？
网上有教的https://www.renrendoc.com/paper/192765314.html，但照着抄了一段代码没有成功，提示运行错误4120，参数无效，请问怎么解决呢
Sub AAA
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 NrRange=ActiveDocument.Range(myRange.Start, myRange.Start)
strNT=myRange.Text
myRange.Delete
ActiveDocument.Footnotes.Add NtRange,  strNT
myRange.SetRange myRange.End, ActiveDocument.Content.End-l
GoTo NF
Loop
End With
Application.ScreenUpdating=True
End Sub

jyjjf

懒得调试了，帮你用AI生成了一个，反正我能用


Sub 宏1()
Dim rng As Range
    Dim findRange As Range
    Dim strPattern As String
    Dim strText As String
   
    ' 定义要查找的文本模式
    strPattern = "【*】"
   
    ' 创建一个范围对象
    Set rng = ActiveDocument.Content
    Set findRange = rng.Duplicate
   
    ' 进行查找
    With findRange.Find
        .ClearFormatting
        .Text = strPattern
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = True
      
        ' 循环查找并替换
        Do While .Execute
            If findRange.Text <> "【" & Chr(42) & "】" Then
                strText = Trim(findRange.Text)
                findRange.Footnotes.Add Range:=findRange, Text:=strText ' 将找到的文本添加为脚注
                findRange.Text = ""
            End If
        Loop
    End With '

End Sub

ChaosSPY1946021

这段代码是VBA（Visual Basic for Applications）代码，用于Microsoft Word文档的自动化处理。具体来说，这个宏（Subroutine）用于在Word文档中寻找特定的文本模式，并把这些模式作为脚注（footnotes）添加到文档中。

以下是代码的详细解释：

1. `Sub AAA`: 定义一个名为`AAA`的子程序（宏）。
2. `Dim myRange As Range, NtRange As Range, strNT As String`: 声明三个变量：`myRange` 和 `NtRange` 用于存储文档中的范围（Range），`strNT` 用于存储找到的文本。
3. `Application.ScreenUpdating=False`: 关闭屏幕更新，以提高代码执行效率。
4. `Set myRange=ActiveDocument.Content`: 将`myRange`设置为当前活动文档的全部内容。
5. `NF:`: 定义一个标签`NF`，用于稍后的`GoTo`语句。
6. `With myRange.Find`: 使用`Find`对象来在`myRange`范围内查找文本。


        * `.Text = "【*】"`: 查找包含"【"开头和"】"结尾的任意字符的文本模式。`*`是一个通配符，表示任意字符。
        * `.MatchWildcards=True`: 启用通配符匹配。
7. `Do While .Execute=True`: 循环执行查找操作，直到找不到更多匹配项。


        * `Set NrRange=ActiveDocument.Range(myRange.Start, myRange.Start)`: 这行代码似乎有误。它意图是设置`NrRange`为与找到的文本相同的范围，但实际上它设置的是一个空范围（起始和结束位置相同）。
        * `strNT=myRange.Text`: 获取找到的文本。
        * `myRange.Delete`: 删除找到的文本。
        * `ActiveDocument.Footnotes.Add NtRange, strNT`: 在`NtRange`指定的位置添加一个脚注，内容为`strNT`。
        * `myRange.SetRange myRange.End, ActiveDocument.Content.End-1`: 更新`myRange`的范围，从当前范围的末尾到文档内容的末尾。
        * `GoTo NF`: 跳回标签`NF`，继续查找下一个匹配项。
8. `End With`: 结束`With`语句。
9. `Application.ScreenUpdating=True`: 重新启用屏幕更新。
10. `End Sub`: 结束子程序。

注意：这段代码可能有一些逻辑错误或需要改进的地方，例如`NrRange`的设置可能是不正确的，并且代码可能无法正确处理文档中的重叠匹配项。在实际使用中，可能需要根据具体情况进行调整和优化。

jtq1234

Sub ConvertCommentsToFootnotes()
    Dim Comment As Comment
    For Each Comment In ActiveDocument.Comments
        Dim rngComment As Range
        Set rngComment = Comment.Scope
        rngComment.Collapse wdCollapseStart
        rngComment.FormattedText = Comment.Range.FormattedText
        rngComment.End = rngComment.End - 1 '去掉注释标记
        rngComment.InsertFootnote ReferenceText:="自动转换的脚注", _
                                FootnoteType:=wdFootnote, _
                                Position:=wdBottomOfPage
        Comment.Delete
    Next Comment
End Sub

ChaosSPY1946021

确实，代码中存在一些错误和潜在的问题。以下是对原始代码进行修正和优化的版本：

```vba
Sub AAA()
    Dim myRange As Range
    Dim NtRange As Range
    Dim strNT As String
    Dim footnoteNum As Integer
    Application.ScreenUpdating = False
   
    Set myRange = ActiveDocument.Content
   
    ' 设置查找条件
    With myRange.Find
        .Text = "【*】"
        .MatchWildcards = True
        .Wrap = wdFindContinue
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
   
    ' 开始查找并添加脚注
    Do While myRange.Find.Execute
        ' 设置脚注范围与找到的文本范围相同
        Set NtRange = myRange.Duplicate
        strNT = NtRange.Text
        
        ' 删除找到的文本
        NtRange.Delete
        
        ' 添加脚注
        footnoteNum = ActiveDocument.Footnotes.Add(NtRange.Start, strNT).Index
        
        ' 更新查找范围以排除刚添加的脚注
        myRange.Start = ActiveDocument.Footnotes(footnoteNum).Range.End
    Loop
   
    Application.ScreenUpdating = True
End Sub
```

这个修正版本的代码做了以下几个更改：

1. 删除了`NF:`标签和`GoTo NF`循环，改为使用`Do While`循环直接控制查找操作。
2. 使用`myRange.Duplicate`来创建`NtRange`，这样`NtRange`就会与找到的文本范围相同，而不是一个空范围。
3. 删除了`myRange.SetRange`这一行，因为它没有正确地设置新的查找范围。取而代之的是，使用`ActiveDocument.Footnotes(footnoteNum).Range.End`来更新查找的起始位置，以跳过新添加的脚注。
4. 添加了`.Wrap = wdFindContinue`和`.Forward = True`来确保查找操作是连续的并且向前进行。
5. 添加了`footnoteNum`变量来存储新添加的脚注的索引，这有助于在需要时引用特定的脚注。

请注意，在Word VBA中处理范围（Range）和脚注时，需要特别小心，因为添加或删除内容可能会改变文档中其他元素的位置。因此，上述代码只是一个基本示例，实际使用中可能还需要考虑更多细节和异常情况。

jyjjf

你代码抄错了，而且代码运行后我的WORD会死循环，估计还要调试

Set NtRange      不是NrRange

myRange.SetRange myRange.End, ActiveDocument.Content.End-1   是减1

lorzl

代码第8行,,应该是Set NtRange

共享精神

评不了分了。感谢后面的热心人回复！