在单词文档中添加定制注释

时间:2018-12-10 14:07:56

标签: vba ms-word comments

第一次发布,请多多包涵...

我有一个文档,其中有各种术语的定义,稍后将在文档中使用。

定义格式= “术语”定义

我希望能够从此列表中添加术语和定义,并在文档的其余部分中添加注释以说明术语和定义,以便在阅读时可以使用术语和定义。文档。

例如:

[文档中的某处] ....使用了术语。...[本段的其余部分]

突出显示术语,并在术语和定义列表中添加带有术语和定义的注释。

我希望我已经对此进行了足够详细的解释,但是如果您需要其他说明,请告诉我。

在此先感谢您的帮助。

2 个答案:

答案 0 :(得分:1)

如果您在术语和定义中使用两列表格,则可以使用如下所示的宏:

Sub Demo()
Application.ScreenUpdating = False
Dim strFnd As String, strTip As String, r As Long
With ActiveDocument
  For r = 2 To .Tables(1).Rows.Count
    strFnd = Split(.Tables(1).Cell(r, 1).Range.Text, vbCr)(0)
    strTip = Split(.Tables(1).Cell(r, 2).Range.Text, vbCr)(0)
    With .Range(.Tables(1).Range.End, .Range.End)
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Text = strFnd
        .Wrap = wdFindStop
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchCase = True
        .Execute
      End With
      Do While .Find.Found
        .Hyperlinks.Add Anchor:=.Duplicate, Address:=.Duplicate, ScreenTip:=strTip, TextToDisplay:=.Text
        .Start = .Hyperlinks(1).Range.End
        .Find.Execute
      Loop
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

请注意,该宏假定:(a)术语和定义是文档中的第一个表,每个术语及其定义都有单独的行,并且仅应检查该表之后的术语; (b)仅处理完全匹配(意味着将跳过复数形式); (c)条款在表格的第一列中,且没有双引号-可以满足引用条款的要求,但我们必须知道您使用的是智能引号还是普通引号; (d)术语和定义仅占据其单元格的第一段。

答案 1 :(得分:0)

我只是将excel列表作为表格粘贴回合同的开头。只要将其设置为[term][definition],就可以解决问题。

Before Picture

After Picture

Sub question()

    Dim defined As Object
    Set defined = CreateObject("Scripting.Dictionary")

    For Each Row In ActiveDocument.Tables(1).Rows

        'left cell
        Dim term As String
        term = Trim(Left(Row.Cells(1).Range.Text, Len(Row.Cells(1).Range.Text) - 2))

        'right cell
        Dim definition As String
        definition = Trim(Left(Row.Cells(2).Range.Text, Len(Row.Cells(2).Range.Text) - 2))

        'connect term and definition
        defined.Add LCase(term), definition

        If Len(term) > 0 And Len(definition) > 0 Then

            'add bookmarks for each word
            With ActiveDocument.Bookmarks
                If Not .Exists(term) Then
                    .Add Range:=Row.Cells(1).Range, Name:=term
                    .DefaultSorting = wdSortByName
                    .ShowHidden = False
                End If
            End With

        End If

    Next Row

    'browse all words in the document
    For Each para In ActiveDocument.Paragraphs
        For Each wrd In para.Range.Words

            'check if current word has a definition (bookmark)
            If ActiveDocument.Bookmarks.Exists(wrd.Text) Then

'                'debug                
'                MsgBox wrd.Text
'                MsgBox defined(LCase(wrd.Text))

                If wrd.Hyperlinks.count = 0 Then
                    'add mouseover definition (screentip) to current term
                    ActiveDocument.Hyperlinks.Add _
                            Anchor:=wrd, _
                            Address:="", _
                            SubAddress:=wrd.Text, _
                            ScreenTip:=defined(LCase(wrd.Text)), _
                            TextToDisplay:=wrd.Text
                End If

            End If

        Next wrd
    Next para

End Sub