CODEWITHSUNDEEP
vbams-word
Simon Price
Simon Price

Reputation: 3261

Add multiple bookmarks and tables

I am trying to add multiple tables and text to a document based on the contents of a multi column listbox.

I am able to add a table and all the other bookmarks, but for some reason when it adds the second table it overwrites the first table and so on.

I would be grateful if someone could tell me where I am going wrong with this and help me put it right. 

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

Upvotes: 1

Views: 577

Answers (2)

Simon Price
Simon Price

Reputation: 3261

figured this out now

i wasnt selecting the range this is how i resolved it 

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

Upvotes: 0

Cindy Meister
Cindy Meister

Reputation: 25663

I believe your problem is that you don't specify where in the document the new bookmark(s) should be added. Bookmarks.Add has a second, optional parameter Range that lets you specify where to create the Bookmark. If you don't provide that information, Word will put it where it wants - you have no control.

Assuming it should follow at the end of r then something like this:

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)

Upvotes: 3

Related Questions