Search code examples
vbams-wordtabular

Adjusting the width of columns of all tables in a Word document


In my Word document, I have over 300 tables and I want to change the table style and adjust the columns' widths. I am using the following code in my VBA macro. It's working for a style but not for column width. Please help me find where the problem is.

Sub Makro1()
'
' Makro1 Makro
'
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Variable"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=4, Extend:=wdExtend
    Selection.Tables(1).Style = "eo_tabelle_2"
    With Tables(1).Spacing
     .Item(1) = 5.5 'adjusts width of text box 1 in cm
     .Item(2) = 8.5 'adjusts width of text box 2 in cm
     .Item(3) = 7.5 'adjusts width of text box 3 in cm
     .Item(4) = 1.1 'adjusts width of text box 4 in cm
End With
End Sub

Solution

  • I'm going to interpret your question literally: that you merely want to process all the tables in the document and that your code is using Find only in order to locate a table...

    The following example shows how you can work with the underlying objects in Word directly, rather than relying on the current Selection, which is what the macro recorder gives you.

    So, at the beginning we declare object variables for the Document and a Table. The current document with the focus is assigned to the first. Then, with For Each...Next we can loop through each Table object in that document and perform the same actions on each one.

    In this case, the style is specified and the column widths set. Note that in order to give a column width in centimeters it's necessary to use a built-in conversion function CentimetersToPoints since Word measures column width in Points.

    Sub FormatTables
      Dim doc as Document
      Dim tbl as Table
    
      Set doc = ActiveDocument
      For Each tbl in doc.Tables
        tbl.Style = "eo_tabelle_2"
        tbl.Columns(1).Width = CentimetersToPoints(5.5)
        tbl.Columns(2).Width = CentimetersToPoints(8.5)
        tbl.Columns(3).Width = CentimetersToPoints(7.5)
        tbl.Columns(4).Width = CentimetersToPoints(1.1)
      Next
    End Sub