Question

我正在尝试根据多列列表框的内容向文档添加多个表和文本。

我能够添加一个表和所有其他书签，但由于某种原因，当它添加第二个表时，它会覆盖第一个表，依此类推。

如果有人能告诉我这出错的地方并帮助我说出来，我将不胜感激。

Private Sub Glossaries()

Dim r As Range
Set r = ActiveDocument.Bookmarks("NewRecommendationText").Range
r.Text = "text here"
With r
.Collapse Direction:=wdCollapseEnd
.InsertParagraphAfter
.Collapse Direction:=wdCollapseEnd
End With

'for each item in the listbox
If lbGlossaries.ListCount > 0 Then

For k = 0 To lbGlossaries.ListCount - 1

Dim tblGloss As Table

ActiveDocument.Bookmarks.Add ("table_" & k)
Dim bm As Range
Set bm = ActiveDocument.Bookmarks("table_" & k).Range
Set tblGloss = ActiveDocument.Tables.Add(bm, lbGlossaries.ListCount + 1, 5)
        'Now populate the header row
        With tblGloss
            For x = 0 To 4
                .Cell(1, x + 1).Range.Select
                If x = 0 Then
                Set_Table_Headers "Customer Name"
                ElseIf x = 1 Then
                    Set_Table_Headers "Product"
                ElseIf x = 2 Then
                    Set_Table_Headers "Fund"
                ElseIf x = 3 Then
                    Set_Table_Headers "Risk Profile"
                ElseIf x = 4 Then
                    Set_Table_Headers "Lump Sum Amount"
                End If
            Next
        End With

        With tblGloss


            .Cell(i + 2, 0).Range.Select
            Set_Table_Rows


            Selection.TypeText Text:=lbGlossaries.Column(0, k)   ' customer
            Selection.MoveRight Unit:=wdCell
            Selection.TypeText Text:=lbGlossaries.Column(1, k) ' selected product
            Selection.MoveRight Unit:=wdCell
            Selection.TypeText Text:=lbGlossaries.Column(2, k) ' selected fund
            Selection.MoveRight Unit:=wdCell
            Selection.TypeText Text:=lbGlossaries.Column(3, k) ' risk profile
            Selection.MoveRight Unit:=wdCell
            Selection.TypeText Text:=lbGlossaries.Column(4, k) ' amount
            Selection.MoveRight Unit:=wdCell
            'Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
            'Selection.Cells.Merge
            'Selection.MoveLeft Unit:=wdCharacter, Count:=1
            'Selection.TypeText Text:=lbGlossaries.Column(5, i) ' reason


        tblGloss.Select
        tblGloss.Columns.AutoFit
        Selection.Collapse Direction:=wdCollapseEnd
        .AutoFitBehavior (wdAutoFitWindow)
        End With

        With bm
        .Collapse Direction:=wdCollapseEnd
        .InsertParagraphAfter
        .Collapse Direction:=wdCollapseEnd
        End With

        ActiveDocument.Bookmarks.Add ("reason_" & k)
        Dim reason As Range
        Set reason = ActiveDocument.Bookmarks("reason_" & k).Range
        reason.Text = lbGlossaries.Column(5, k) ' reason



        ''add the glossary text under here
        activeBookmark = activeBookmark & "_glossary" & k
        ActiveDocument.Bookmarks.Add (activeBookmark)

        Dim glossary As Range
        Set glossary = ActiveDocument.Bookmarks(activeBookmark).Range
        glossary.Text = lbGlossaries.Column(6, i) & Chr(13) & Chr(13)

        ''add the tax glossary text under here
        activeBookmark = activeBookmark & "_Tax_glossary" & k
        ActiveDocument.Bookmarks.Add (activeBookmark)

        Dim TaxGlossary As Range
        Set TaxGlossary = ActiveDocument.Bookmarks(activeBookmark).Range
        TaxGlossary.Text = lbGlossaries.Column(7, i) & Chr(13) & Chr(13)

        ''add the encashment glossary text under here
        activeBookmark = activeBookmark & "_Encashment_glossary" & k
        ActiveDocument.Bookmarks.Add (activeBookmark)
        Dim encashment As Range
        Set encashment = ActiveDocument.Bookmarks(activeBookmark).Range
        encashment.Text = lbGlossaries.Column(8, i) & Chr(13) & Chr(13)

        ''add the encashment designation text under here
        activeBookmark = activeBookmark & "_designation" & k
        ActiveDocument.Bookmarks.Add (activeBookmark)

        Dim designation As Range
        Set designation = ActiveDocument.Bookmarks(activeBookmark).Range
        If lbCgt.Column(9, k) <> "" Then
            designation.Text = lbGlossaries.Column(10, i)
        Else
            ActiveDocument.Bookmarks(activeBookmark).Delete
        End If




Next
End If

Answer 1

我认为您的问题是您没有在文档中指定 where 应添加新书签。 Bookmarks.Add有第二个可选参数Range，可让您指定创建书签的位置。如果你没有提供这些信息，Word会把它放在你想要的地方 - 你无法控制。

假设它应该在r结尾处跟随，那么就是这样：

Dim bm As Range
Set bm = r.Duplicate
ActiveDocument.Bookmarks.Add ("table_" & k, bm)
' Do things...
Dim reason As Range
Set reason = bm.Duplicate
ActiveDocument.Bookmarks.Add ("reason_" & k, reason)

Answer 2

现在想出来

我没有选择范围，这就是我如何解决它

encashment.Select
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
ActiveDocument.Bookmarks.Add
....

添加多个书签和表格

2 个答案: