MS-Excel 열을 메모로 입력하십시오.

Question

상황 : 엑셀에 포함 된 키워드/ID를 단어 문서를 통해 검색하려고 할 때마다 스프레드 시트의 주석을 단어 문서에 추가하려고합니다. 키워드/ID가 저장됩니다. 예제 코드는 키워드/ID 목록을 통해 실행되지만 첫 번째 발생에 대해서만 설명합니다.

부여 : 단어 파일은 C : \ Test \ ACBS.docx에 있으며 VBA 매크로를 실행하는 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

는 내가이 설정의 말씀의 구성 요소를 이해하지만 당신은 엑셀 파일에있는 모든 주석을 나열 할 경우, 당신은 그렇게 아래 스크립트를 사용할 수 있습니다 모르겠어요.

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