MS-Excelの列をコメント

Question

にインポートしてください。状況： Excelに含まれるキーワード/ IDをワードドキュメントで検索し、スプレッドシートのコメントをワードドキュメントに追加しようとしています。キーワード/ IDを保存します。私は、キーワード/ IDのリストを実行しているが、最初のオカレンスだけをコメントします。

与えます： 単語ファイルはC：\ Test \ ACBS.docxにあり、VBAマクロを実行しているExcelがあります。別々に。 Excelでは、検索用語変数 "FindWord"は列Aにあり、コメントは列Bの変数 "CommentWord"です。

問題： どのように単語文書全体を検索してコメントすることができますかキーワード/ IDの発生？

コード：

Sub Comments_Excel_to_Word() 
'Author: Paul Keahey 
'Date: 2017-10-30 
'Name:Comments_Excel_to_Word 
'Purpose: To bring in comments From Excel to Word. 
'Comments: None 

Dim objWord 
Dim objDoc 
Dim objSelection 
Set objWord = CreateObject("Word.Application") 
Set objDoc = objWord.Documents.Open("C:\Test\ACBS.docx") 
objWord.Visible = True 
Set objSelection = objWord.Selection 
Dim oRng As Word.range 
Set oRng = objSelection.range 
Set oScope = oRng.Duplicate 
Dim oCol As New Collection 
Dim FindWord As String 
Dim CommentWord As String 
Dim I As Integer 



'initalize list of varables 


For I = 2 To range("A1").End(xlDown).Row 

FindWord = Sheet1.range("A" & I).Value 
CommentWord = Sheet1.range("B" & I).Value 

With oRng.Find 
    .Text = FindWord 
    .Replacement.Text = "" 
    .Forward = True 
    .Wrap = wdFindContinue 
    .Format = False 
    .MatchCase = False 
    .MatchWholeWord = False 
    .MatchWildcards = True 
    .MatchSoundsLike = False 
    .MatchAllWordForms = False 
    Do While .Execute = True 
     If oRng.InRange(oScope) Then 
      On Error Resume Next 
      'MsgBox "oRng.InRange(oScope)" 
      oCol.Add oRng.Text, oRng.Text 
      On Error GoTo 0 
       oRng.Collapse wdCollapseEnd 
       Else 
      ActiveDocument.Comments.Add oRng, CommentWord 

       Exit Do 
      End If 
     Loop 

    End With 
Next I 

objDoc.Save 

End Sub 

Answer 1

私は、このセットアップのWordの構成要素を理解していないが、あなたはあなたのExcelファイル内のすべてのコメントを一覧表示したい場合、あなたはそれを行うには、以下のスクリプトを使用することができます。

Sub ShowCommentsAllSheets() 
'Update 20140508 
Dim commrange As Range 
Dim rng As Range 
Dim ws As Worksheet 
Dim newWs As Worksheet 
Set newWs = Application.Worksheets.Add 
newWs.Range("A1").Resize(1, 4).Value = Array("Sheet", "Address", "Value", "Comment") 
Application.ScreenUpdating = False 
On Error Resume Next 
For Each ws In Application.ActiveWorkbook.Worksheets 
    Set commrange = ws.Cells.SpecialCells(xlCellTypeComments) 
    If Not commrange Is Nothing Then 
     i = newWs.Cells(Rows.Count, 1).End(xlUp).Row 
     For Each rng In commrange 
      i = i + 1 
      newWs.Cells(i, 1).Resize(1, 4).Value = Array(ws.Name, rng.Address, rng.Value, rng.Comment.Text) 
     Next 
    End If 
    Set commrange = Nothing 
Next 
newWs.Cells.WrapText = False 
Application.ScreenUpdating = True 
End Sub