VBA 在 MS word 中：将来自 excel 的评论添加到所选文本

Question

我在 word 中添加了宏，将 excel 中收集的评论（例如，请参阅下面的 doc 和 excel 中的引文）到 word 文档中的匹配词。我想将这些注释 仅添加到文本的选定部分 而不是整个文档（在下面的示例中，选定的将是文本的前 4 行，因此宏应该添加注释“请致电 1111111”到“问题 1”并评论“请致电 2222222”到“问题 2”，但在第 6 行中第二次出现“问题 1”而不加评论，因为这不在选择中。任何想法如何解决这个问题？

word文档，例子：

1字问题1字字字字
2word word word word word word
3word word word issue2 word
4word word word word word word
5word word word word word word
6字字问题1字字字
7字字问题3字字

Table 在 excel 中添加文本作为评论（2 列）：

"issue1" "请拨打1111111"
“问题2”“请致电2222222”
"issue3" "请拨打 3333333"

我的宏 现在从所选部分（文档的前 4 行）中查找单词，但会向整个文本添加注释直到文档末尾，这意味着还会向“添加注释”问题 1"，出现在第 6 行且未被选中。

Sub InsertCommentFromExcel()  
Dim objExcel As Object   
Dim ExWb As Object  
Dim strWorkBook As String  
Dim i As Long  
Dim lastRow As Long  
Dim oRng As range  
Dim sComment As String  
   strWorkBook = "C:\Document\excelWITHcomments.xlsx"   
   Set objExcel = CreateObject("Excel.Application") 
   Set ExWb = objExcel.Workbooks.Open(strWorkBook)  
   lastRow = ExWb.Sheets("Words").range("A" & ExWb.Sheets("Words").Rows.Count).End(-4162).Row  
   For i = 1 To lastRow  
     Set oRng = Selection.Range  
     Do While oRng.Find.Execute(ExWb.Sheets("Words").Cells(i, 1)) = True  
     sComment = ExWb.Sheets("Words").Cells(i, 2)  
     oRng.Comments.Add oRng, sComment  
     Loop 
   Next  
ExWb.Close  
lbl_Exit:  
Set ExWb = Nothing  
Set objExcel = Nothing  
Set oRng = Nothing  
Exit Sub  
End Sub

Answer 1

lastPosition 保存您选择的结尾。在每个 Find.Execute 之后，都会检查找到的范围的开始是否在保存的 lastPosition 之前。如果它落后于 lastPosition，则查找循环停止。

Sub InsertCommentFromExcel()
Dim objExcel As Object
Dim ExWb As Object
Dim strWorkBook As String
Dim i As Long
Dim lastRow As Long
Dim oRng As Range
Dim sComment As String

   strWorkBook = "C:\Document\excelWITHcomments.xlsx"
   Set objExcel = CreateObject("Excel.Application")
   Set ExWb = objExcel.Workbooks.Open(strWorkBook)
   lastRow = ExWb.Sheets("Words").Range("A" & ExWb.Sheets("Words").Rows.Count).End(-4162).Row
   
   Set oRng = Selection.Range

   Dim firstPosition As Long, lastPosition As Long
   firstPosition = oRng.Start
   lastPosition = oRng.End
   
   For i = 1 To lastRow
     Do While oRng.Find.Execute(ExWb.Sheets("Words").Cells(i, 1)) = True
        If oRng.Start > lastPosition Then Exit Do
        sComment = ExWb.Sheets("Words").Cells(i, 2)
        oRng.Comments.Add oRng, sComment
     Loop
     Set oRng = ActiveDocument.Range(firstPosition, lastPosition)
   Next

ExWb.Close

lbl_Exit:
    Set ExWb = Nothing
    Set objExcel = Nothing
    Set oRng = Nothing
Exit Sub
End Sub

VBA 在 MS word 中：将来自 excel 的评论添加到所选文本

VBA in MS word: adding comments from excel to selected text

vba

ms-word

selectedtext