none
The problem with inserting the information in multi tables via vba in word RRS feed

  • Question

  • Hello,eveyone

    I am trying to create multi tables in vba. Let us supposed the first table is already done. Below is the code , what I am trying to creat the second table. My question is, why all the information, I tried to insert the second table cell(1,1), all go back to the cell(1,1) of the first table, how I can correct it. I will so apprieciate, when someone can offer me some help.

    With ActiveDocument
    Set mycells=.Range(start:.Tables(1).cell(1,1).Range.start,End:=.Tables(1).Cell(2,1).Range.End)
    
    End With
    
    With Selection.Tables(1)
    .Cell(1,1).Select
    Selection.Cells.Width=CentimeterToppoints(16.7)
    Seelection.Typetext Text="........" 

    Tuesday, November 19, 2013 8:00 PM

Answers

  • Hi Pete

    You're going to have problems if you work solely with the Selection object. Yes, this is indeed what the macro recorder gives you, and recorded code can be use for simple tasks. But as soon as you want to perform more complex tasks you need to use the recorded code as a guide and learn to apply it to the object model.

    With the object model, you work directly with the document and things in it - paragraphs, tables, etc. Because you work with things - "objects" - you can address them directly. That removes ambiguity (where is the current selection, really?) and makes your code more readable because it's obvious what is currently being manipulated.

    So, with that in mind...

    Dim doc as Word.Document
    Dim tbl1 as Word.Table, rngTbl1 as Word.Range
    Dim tbl2 as Word.Table

    Set doc = ActiveDocument
    Set tbl1 = doc.Tables(1)
    'Do things with tbl1
    Set rngTbl1 = tbl1.Range
    rngTbl1.InsertAfter vbCr 'Insert a paragraph after the table
    rngTbl1.Collapse wdCollapseEnd
    Set rngTbl2 = doc.Tables.Add(Range:=rngTbl1, NumRows:=3, NumColumns:=3)

    The Collapse method is the key, here. When you assign a Table.Range to a Range object, the object contains the table. When you collapse a Table object it's like pressing the Right Arrow key when a table is selected: the focus moves to the beginning of the paragraph immediately following the table.

    The code above adds a new paragraph mark after that, so that there's a paragraph between the tables. At this point, that new paragraph is part of the range with the table and the last paragraph mark. Collapsing the Range at this point puts the focus to the start of the new paragraph mark. And the new table is inserted at this point.


    Cindy Meister, VSTO/Word MVP, my blog

    Wednesday, November 20, 2013 3:53 PM
    Moderator
  • The counter is of no consequence. What matters is that the code shows you how you can insert separate tables and reference them as such, all without the need to select anything. Taking your code as the starting point, you could use something like:

    Sub Imp_ac()
    Dim Tbl As Table
    Dim myCells As Range
    With ActiveDocument
      With .Range
        With .Font
          .Name = "Arial"
          .Size = 11
          .Bold = True
          .UnderlineColor = wdColorAutomatic
          .Underline = wdUnderlineSingle
        End With
        .InsertAfter "Import actions"
        .InsertParagraphAfter
        Set Tbl = .Tables.Add(Range:=.Characters.Last, NumRows:=2, _
          NumColumns:=1, DefaultTableBehavior:=wdWord8TableBehavior, _
          AutoFitBehavior:=wdAutoFitFixed)
        With Tbl
          If .Style <> "Tabellengitternetz" Then .Style = "Tabellengitternetz"
          ' i have changed the value booblean here!!check it
          .ApplyStyleHeadingRows = False
          .ApplyStyleLastRow = False
          .ApplyStyleFirstColumn = False
          .ApplyStyleLastColumn = False
          .ApplyStyleRowBands = False
          .ApplyStyleColumnBands = False
          .AllowAutoFit = True
          Set myCells = .Range(Start:=Tbl.Cell(1, 1).Range.Start, End:=Tbl.Cell(2, 1).Range.End)
          With myCells
            With .Font
              .Size = 8
              .Underline = wdUnderlineNone
            End With
            .Borders(wdBorderBottom).LineWidth = wdLineWidth150pt
            .Borders(wdBorderTop).LineWidth = wdLineWidth150pt
            .Borders(wdBorderLeft).LineWidth = wdLineWidth150pt
            .Borders(wdBorderRight).LineWidth = wdLineWidth150pt
            .Borders(wdBorderHorizontal).LineWidth = wdLineWidth150pt
            .Borders(wdBorderVertical).LineWidth = wdLineWidth150pt
          End With
          With .Cell(1, 1)
            .Width = CentimetersToPoints(16.7)
            .TypeText Text:=""
          End With
          With .Cell(2, 1)
            .Width = CentimetersToPoints(16.7)
            .TypeText Text:=""
          End With
        End With
        .InsertAfter "Text after table 1"
        'Prepare for Table 2
        .InsertParagraphAfter
        'Create table 2
        Set Tbl = .Tables.Add(Range:=.Characters.Last, NumRows:=2, _
          NumColumns:=1, DefaultTableBehavior:=wdWord8TableBehavior, _
          AutoFitBehavior:=wdAutoFitFixed)
        'Process table 2
        With Tbl
          '.....
        End With
    End With


    Cheers
    Paul Edstein
    [MS MVP - Word]


    Wednesday, November 20, 2013 10:01 PM

All replies

  • Here's a trivial demo:

    Sub Demo()
    Dim i As Long, Tbl As Table
    With ActiveDocument
      For i = 1 To 3
        Set Tbl = .Tables.Add(Range:=.Characters.Last, NumRows:=i, NumColumns:=i)
        .Range.InsertAfter vbCr
        With Tbl
          .Cell(1, 1).Range.Text = "This is table " & i
        End With
      Next
    End With
    End Sub

    Note that there's no need to select anything.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Wednesday, November 20, 2013 12:01 AM
  • hallo,sir, first thanks your suggestion. I tried your method but I still can not get it. cause my first table is already there, no need to add a counter there. I just to need correct the code fo the second tabel, this time i put it all my code on. it will be so helpful, wenn you can offer me some help.

    Sub Imp_ac()
    Dim tbl As Table
        Dim myCells As Range
        
        Selection.Font.Name = "Arial"
        Selection.Font.Size = 11
        Selection.Font.Bold = True
        Selection.Font.UnderlineColor = wdColorAutomatic
        Selection.Font.Underline = wdUnderlineSingle
        Selection.TypeText Text:="Import actions"
        Selection.TypeParagraph
        
        ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
            1, DefaultTableBehavior:=wdWord8TableBehavior, AutoFitBehavior:= _
            wdAutoFitFixed
           
        
        With Selection.Tables(1)
            If .Style <> "Tabellengitternetz" Then
                .Style = "Tabellengitternetz"
            End If
            ' i have changed the value booblean here!!check it
            .ApplyStyleHeadingRows = False
            .ApplyStyleLastRow = False
            .ApplyStyleFirstColumn = False
            .ApplyStyleLastColumn = False
            .ApplyStyleRowBands = False
            .ApplyStyleColumnBands = False
            .AllowAutoFit = True
        End With
        
        With ActiveDocument
            Set myCells = .Range(Start:=.Tables(1).Cell(1, 1).Range.Start, _
                End:=.Tables(1).Cell(2, 1).Range.End)
            myCells.Select
            With Selection.Cells
            Selection.Font.Size = 8
            Selection.Font.Underline = wdUnderlineNone
        .Borders(wdBorderBottom).LineWidth = wdLineWidth150pt
        .Borders(wdBorderTop).LineWidth = wdLineWidth150pt
        .Borders(wdBorderLeft).LineWidth = wdLineWidth150pt
        .Borders(wdBorderRight).LineWidth = wdLineWidth150pt
        .Borders(wdBorderHorizontal).LineWidth = wdLineWidth150pt
        .Borders(wdBorderVertical).LineWidth = wdLineWidth150pt
       
           
        End With
        End With
        
         With Selection.Tables(1)
       .Cell(1, 1).Select
       'Selection.Cells.PreferredWidthType = wdPreferredWidthAuto
       Selection.Cells.Width = CentimetersToPoints(16.7)
       Selection.TypeText Text:=""
       
       
       .Cell(2, 1).Select
       Selection.Cells.Width = CentimetersToPoints(16.7)
       Selection.TypeText Text:=""
       
       End With
    End Sub

      


    • Edited by Pete0929 Wednesday, November 20, 2013 9:58 AM better
    Wednesday, November 20, 2013 9:29 AM
  • Hi Pete

    You're going to have problems if you work solely with the Selection object. Yes, this is indeed what the macro recorder gives you, and recorded code can be use for simple tasks. But as soon as you want to perform more complex tasks you need to use the recorded code as a guide and learn to apply it to the object model.

    With the object model, you work directly with the document and things in it - paragraphs, tables, etc. Because you work with things - "objects" - you can address them directly. That removes ambiguity (where is the current selection, really?) and makes your code more readable because it's obvious what is currently being manipulated.

    So, with that in mind...

    Dim doc as Word.Document
    Dim tbl1 as Word.Table, rngTbl1 as Word.Range
    Dim tbl2 as Word.Table

    Set doc = ActiveDocument
    Set tbl1 = doc.Tables(1)
    'Do things with tbl1
    Set rngTbl1 = tbl1.Range
    rngTbl1.InsertAfter vbCr 'Insert a paragraph after the table
    rngTbl1.Collapse wdCollapseEnd
    Set rngTbl2 = doc.Tables.Add(Range:=rngTbl1, NumRows:=3, NumColumns:=3)

    The Collapse method is the key, here. When you assign a Table.Range to a Range object, the object contains the table. When you collapse a Table object it's like pressing the Right Arrow key when a table is selected: the focus moves to the beginning of the paragraph immediately following the table.

    The code above adds a new paragraph mark after that, so that there's a paragraph between the tables. At this point, that new paragraph is part of the range with the table and the last paragraph mark. Collapsing the Range at this point puts the focus to the start of the new paragraph mark. And the new table is inserted at this point.


    Cindy Meister, VSTO/Word MVP, my blog

    Wednesday, November 20, 2013 3:53 PM
    Moderator
  • The counter is of no consequence. What matters is that the code shows you how you can insert separate tables and reference them as such, all without the need to select anything. Taking your code as the starting point, you could use something like:

    Sub Imp_ac()
    Dim Tbl As Table
    Dim myCells As Range
    With ActiveDocument
      With .Range
        With .Font
          .Name = "Arial"
          .Size = 11
          .Bold = True
          .UnderlineColor = wdColorAutomatic
          .Underline = wdUnderlineSingle
        End With
        .InsertAfter "Import actions"
        .InsertParagraphAfter
        Set Tbl = .Tables.Add(Range:=.Characters.Last, NumRows:=2, _
          NumColumns:=1, DefaultTableBehavior:=wdWord8TableBehavior, _
          AutoFitBehavior:=wdAutoFitFixed)
        With Tbl
          If .Style <> "Tabellengitternetz" Then .Style = "Tabellengitternetz"
          ' i have changed the value booblean here!!check it
          .ApplyStyleHeadingRows = False
          .ApplyStyleLastRow = False
          .ApplyStyleFirstColumn = False
          .ApplyStyleLastColumn = False
          .ApplyStyleRowBands = False
          .ApplyStyleColumnBands = False
          .AllowAutoFit = True
          Set myCells = .Range(Start:=Tbl.Cell(1, 1).Range.Start, End:=Tbl.Cell(2, 1).Range.End)
          With myCells
            With .Font
              .Size = 8
              .Underline = wdUnderlineNone
            End With
            .Borders(wdBorderBottom).LineWidth = wdLineWidth150pt
            .Borders(wdBorderTop).LineWidth = wdLineWidth150pt
            .Borders(wdBorderLeft).LineWidth = wdLineWidth150pt
            .Borders(wdBorderRight).LineWidth = wdLineWidth150pt
            .Borders(wdBorderHorizontal).LineWidth = wdLineWidth150pt
            .Borders(wdBorderVertical).LineWidth = wdLineWidth150pt
          End With
          With .Cell(1, 1)
            .Width = CentimetersToPoints(16.7)
            .TypeText Text:=""
          End With
          With .Cell(2, 1)
            .Width = CentimetersToPoints(16.7)
            .TypeText Text:=""
          End With
        End With
        .InsertAfter "Text after table 1"
        'Prepare for Table 2
        .InsertParagraphAfter
        'Create table 2
        Set Tbl = .Tables.Add(Range:=.Characters.Last, NumRows:=2, _
          NumColumns:=1, DefaultTableBehavior:=wdWord8TableBehavior, _
          AutoFitBehavior:=wdAutoFitFixed)
        'Process table 2
        With Tbl
          '.....
        End With
    End With


    Cheers
    Paul Edstein
    [MS MVP - Word]


    Wednesday, November 20, 2013 10:01 PM