时间戳

首页 > 解决方案 > 将单元格从 Excel 导入 Word 作为评论的回复

excel - 将单元格从 Excel 导入 Word 作为评论的回复

问题描述

我需要从excel中导入单元格作为评论的回复（原始评论的孩子）

我使用以下属性将评论从 .docx 文件导出到 .xls：

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

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

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

这是我用于将注释从 word 导出到 Excel 的宏：

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

谢谢！

标签： excelvbams-word

解决方案

所以首先，您需要使用您提供的宏，然后保存宏创建的 excel 文件。

然后假设您将回复添加到“我”列中的评论

在此处输入图像描述

然后将以下代码复制到您的主 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

希望它会奏效！如果某些事情令人困惑或需要更多澄清，请不要害怕提问。

推荐阅读