單詞評論提取：幫助獲取編號標題

Question

我決定在兩週前學習VBA，它變得相當流暢。但是，現在我遇到了一個我自己無法解決的問題。 我已經設置了一個包含各種模塊的Excel文檔。其中一個模塊將word文檔中的註釋提取到excel表單中，該表單按預期工作。

問題是，我沒有能夠提取每個評論上面的第一個編號標題，我非常喜歡。目前，我必須在提取評論後手動完成此操作。作爲一個例子，我還想提取每個評論上面的第一個標題和數字，例如'2.1.1標題'。如果註釋突出顯示標題本身，則應該是提取的標題。

我已經嘗試了許多基於我可以在網上找到的東西，但每次遇到各種各樣的錯誤時，我似乎無法修復。我還沒有找到一些即使是有些作品。我確實嘗試了一種顯然應該在Word VBA中工作的方法，但我無法在Excel中使用它。

有誰知道我會如何去提取編號的標題？任何提示或技巧將不勝感激。

這是我對模塊的代碼：

Sub ImportCommentsDOCX() 
    Dim wdDoc As Object 
    Dim wdFileName As Variant 
    Dim i As Integer 

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _ 
     "Browse for file to be imported") 
    If wdFileName = False Then Exit Sub '(user cancelled import file browser) 
    Set wdDoc = GetObject(wdFileName) 'open Word file 
    '1: if no comments' 
    With wdDoc 
     If wdDoc.Comments.Count = 0 Then 
      MsgBox ("No comments") 
     End If 
     '2; Set excel headers' 
     Range("B" & 1).Value = "Number" 
     Range("B" & 1).Font.Bold = True 
     Range("C" & 1).Value = "Comment" 
     Range("C" & 1).Font.Bold = True 
     Range("D" & 1).Value = "Highlighted text" 
     Range("D" & 1).Font.Bold = True 
     Range("E" & 1).Value = "Initials" 
     Range("B" & 1).Font.Bold = True 
     Range("F" & 1).Value = "Date (*Imprecise)" 
     Range("F" & 1).Font.Bold = True 

     '3: Extract comments and meta data' 
     For i = 1 To wdDoc.Comments.Count 
      Range("B" & 1 + i).Value = wdDoc.Comments(i).Index 
      Range("C" & 1 + i).Value = wdDoc.Comments(i).Range 
      Range("D" & 1 + i).Value = wdDoc.Comments(i).Scope.FormattedText 
      Range("E" & 1 + i).Value = wdDoc.Comments(i).Initial 
      Range("F" & 1 + i).Value = Format(wdDoc.Comments(i).Date, "dd/MM/yyyy") 'Unreliable: Sometimes gives wrong date' 
      'Range("G" & 3 + i).Value = wdDoc.Comments(i).Range.ListFormat.ListString 'Returns empty' 
     Next i 
    End With 
    Set wdDoc = Nothing 
    MsgBox ("Extraction has completed") 
End Sub 

Answer 1

這裏是你的代碼進行一些調整：

Sub ImportCommentsDOCX() 
    Dim wdDoc As Object 
    Dim wdFileName As Variant 
    Dim i As Integer 

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _ 
     "Browse for file to be imported") 
    If wdFileName = False Then Exit Sub '(user cancelled import file browser) 
    Set wdDoc = GetObject(wdFileName) 'open Word file 
    '1: if no comments' 
    With wdDoc 
     wdDoc.Activate ' Added 
     If wdDoc.Comments.Count = 0 Then 
      MsgBox ("No comments") 
     End If 
     '2; Set excel headers' 
     Range("B" & 1).Value = "Number" 
     Range("B" & 1).Font.Bold = True 
     Range("C" & 1).Value = "Comment" 
     Range("C" & 1).Font.Bold = True 
     Range("D" & 1).Value = "Highlighted text" 
     Range("D" & 1).Font.Bold = True 
     Range("E" & 1).Value = "Initials" 
     Range("E" & 1).Font.Bold = True ' Modified 
     Range("F" & 1).Value = "Date (*Imprecise)" 
     Range("F" & 1).Font.Bold = True 

     '3: Extract comments and meta data' 
     For i = 1 To wdDoc.Comments.Count 
      Range("B" & 1 + i).Value = wdDoc.Comments(i).Index 
      Range("C" & 1 + i).Value = wdDoc.Comments(i).Range 
      Range("D" & 1 + i).Value = wdDoc.Comments(i).Scope.FormattedText 
      Range("E" & 1 + i).Value = wdDoc.Comments(i).Initial 
      Range("F" & 1 + i).Value = Format(wdDoc.Comments(i).Date, "dd/MM/yyyy") 'Unreliable: Sometimes gives wrong date' 
      'Range("G" & 1 + i).Value = wdDoc.Comments(i).Scope.ListFormat.ListString 'Returns empty' ' Modified ' Updated 
      Dim wp As Word.Paragraph: Set wp = wdDoc.Comments(i).Scope.Paragraphs(1) ' Updated 
      Do While wp.Range.ListFormat.ListString = "" ' Updated 
       Set wp = wp.Previous ' Updated 
      Loop ' Updated 
      Range("G" & 1 + i).Value = wp.Range.ListFormat.ListString ' Updated 
     Next i 
    End With 
    Set wdDoc = Nothing 
    MsgBox ("Extraction has completed") 
End Sub 

請注意我的意見：添加和修改

1. wdDoc.Activate至少在我的電腦上是必需的，否則 Range屬性是空的。
2. 縮寫後一個錯誤的柱加粗
3. 原文由Range屬性，而不是範圍（這是註釋的內容）的簡稱，所以它的ListFormat財產應當用於
4. 行索引是不正確的（3而不是1）