Question

我需要从Excel导入单元格到单词作为评论的回复（原始评论的子元素）

我将具有以下属性的注释从.docx文件导出到.xls：

oComment.Index
oComment.Reference.Information(wdActiveEndAdjustedPageNumber)
oComment.Initial,
oComment.Author,
oComment.Date,
oComment.Range

我在excell的新单元格中添加了对这些评论的回复。现在，我想将这些答复再次导入到Word中，但作为这些原始注释的答复。我想这将是可能的，因为原始评论的索引是相同的。您能帮我解决这个问题吗：)？我无法在VBA中编写代码，也没有在互联网上找到此问题的答案。

PS。我还需要信息，如果需要我应该添加哪个库。

这是我用于将单词从单词导出到excell的宏：

Sub Export_Comments()

    ' Purpose: Search for comments in any text that's been p
    ' this document, then export them into a new Excel spreadsheet.
    ' Requires reference to Microsoft Excel 15.0 Object Library in VBA,
    ' which should already be saved with as part of the structure of
    ' this .docm file.

    Dim bResponse As Integer

    ' Exit routine if no comments have been found.
    If ActiveDocument.Comments.Count = 0 Then
      MsgBox ("No comments found in this document")
      Exit Sub
    Else
      bResponse = MsgBox("Do you want to export all comments to an Excel worksheet?", _
                  vbYesNo, "Confirm Comment Export")
      If bResponse = 7 Then Exit Sub
    End If

    ' Create a object to hold the contents of the
    ' current document and its text. (Shorthand
    ' for the ActiveDocument object.
    Dim wDoc As Document
    Set wDoc = ActiveDocument

    ' Create objects to help open Excel and create
    ' a new workbook behind the scenes.
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook

    Dim i As Integer
    Dim oComment As Comment         'Comment object

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False

    ' Create a new Workbook. Shouldn't interfere with
    ' other Workbooks that are already open. Will have
    ' at least one worksheet by default.
    Set xlWB = xlApp.Workbooks.Add

    With xlWB.Worksheets(1).Range("A1")

      ' Create headers for the comment information
      .Offset(0, 0) = "Comment Number"
      .Offset(0, 1) = "Page Number"
      .Offset(0, 2) = "Reviewer Initials"
      .Offset(0, 3) = "Reviewer Name"
      .Offset(0, 4) = "Date Written"
      .Offset(0, 5) = "Comment Text"

      ' Export the actual comments information
      For i = 1 To wDoc.Comments.Count
       Set oComment = wDoc.Comments(i)
       Set rngaComment = oComment.Reference
       rngaComment.Select
       Set rngHeading = wDoc.Bookmarks("\HeadingLevel").Range
       rngHeading.Collapse wdCollapseStart
       Set rngHeading = rngHeading.Paragraphs(1).Range
      .Offset(i, 0) = oComment.Index
      .Offset(i, 1) = oComment.Reference.Information(wdActiveEndAdjustedPageNumber)
      .Offset(i, 2) = oComment.Initial
      .Offset(i, 3) = oComment.Author
      .Offset(i, 4) = Format(oComment.Date, "dd/mm/yyyy")
      .Offset(i, 5) = oComment.Range
      .Offset(i, 6) = rngHeading.ListFormat.ListString & " " & rngHeading.Text
      .Offset(i, 7) = Format(oComment.Date, "dd/mm/yyyy hh:mm:ss")
    Next i
    End With

    ' Make the Excel workbook visible
    xlApp.Visible = True

    ' Clean up our objects
    Set oComment = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
    End Sub

谢谢！

Answer 1

因此，首先，您需要使用提供的宏，然后保存该宏创建的Excel文件。

然后，假设您将回复添加到了“ I”列中的评论中。

然后将以下代码复制到主Word文档中并运行它。它将打开Excel文件（不要忘记更改代码中的路径！），遍历所有行，获取注释和您的答复的索引，在Word文件中搜索此注释，然后将新答复添加到它。如果您将I列中的一个值留空，宏将跳过它并转到下一行。

Sub Reply()
Dim excel As excel.Application
Dim wb    As Workbook
Dim ws    As Worksheet

Set excel = New excel.Application
'change this path to the path of excel file with extracted comments
Set wb = excel.Workbooks.Open("C:\Users\Kirszu\Desktop\Book1.xlsx")
Set ws = wb.Worksheets(1)
excel.Visible = True

Dim doc As Document
Set doc = ActiveDocument

Dim comments As Variant
Dim com      As Variant
Set comments = doc.comments()

Dim i        As Long
Dim lastRow  As Long
Dim index As Long
Dim count As Long
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row

For i = 2 To lastRow
    index = ws.Cells(i, 1).Value
    comReply = ws.Cells(i, 9).Value
    For Each com In comments
        If com.index() = index + count Then
            Set repl = com.replies()
            If comReply <> "" Then
                repl.Add Range:=com.Range, _
                Text:=comReply
                count = count + 1
            End If
            Exit For
        End If
    Next com
Next i
End Sub

希望它会起作用！如果有什么令人困惑或需要进一步澄清的地方，不要害怕问。

将单元格从Excel导入到Word作为注释的回复

1 个答案: