Consulting

Results 1 to 3 of 3

Thread: Apply Formatting to Tables According to Content

  1. #1
    VBAX Regular
    Joined
    Apr 2018
    Posts
    8
    Location

    Apply Formatting to Tables According to Content

    I have a document that is ~1200 pages and contains hundreds of tables. There are two types of tables. I already have code that will apply standardized formatting to all tables; however, in this instance, I need to apply different formatting to each table type. For one table type, I need shading on the first row. For the second table type, I need the shading in the first column. The tables have varying numbers of columns and rows.

    I have managed to cobble together code that will search for the specific text that is in each table type and format the table accordingly. As it is now, it searches for text anywhere in the table. It would be more reliable if it would search the first row of each table for the specific text. That is where I am stuck. I have limited experience with VBA, and I do not know which commands would do that or how the commands fit into my current code. In addition, I have it as two subs—one that calls on the other. I do not know if that is good, bad, or somewhere in between.

    Would you look at my code and tell me what I need to change to get it to search in the first row? Thank you for considering my request.

    Sub Table1_Format()



    DimobjTable As Table

    DimobjCell As Cell

    DimobjRange As Range


    Application.ScreenUpdating= False
    ForEach objTable In ActiveDocument.Tables

    For Each objCell In objTable.Range.Cells

    Set objRange = objCell.Range
    objRange.End = objRange.End - 1

    Dim cellvalue As String

    'Enter textinside quotation marks
    If InStr(objRange, "ABCD")Then


    objTable.Range.Font.Name ="Arial"
    objTable.Range.Font.Size = 8
    objTable.Range.Font.ColorIndex =wdAuto
    objTable.Rows.AllowBreakAcrossPages =False
    objTable.Rows.Alignment =wdAlignRowCenter
    objTable.Rows.HeightRule =wdRowHeightAuto
    objTable.Rows.Borders.InsideLineStyle= wdLineStyleSingle
    objTable.Rows.Borders.InsideLineWidth= wdLineWidth050pt
    objTable.Rows.Borders.OutsideLineStyle = wdLineStyleSingle
    objTable.Rows.Borders.OutsideLineWidth= wdLineWidth150pt
    objTable.Rows.Borders.InsideColor =wdColorBlack

    objTable.AutoFitBehavior(wdAutoFitContent)
    objTable.PreferredWidthType =wdPreferredWidthPercent
    objTable.PreferredWidth = 100

    objTable.Columns(1).Shading.BackgroundPatternColor = wdColorGray10
    objTable.Columns(1).Select
    Selection.Font.Bold = True




    End If
    Next
    Next

    CallTable2_Format

    EndSub



    Sub Table2_Format()

    DimobjTable As Table
    DimobjCell As Cell
    DimobjRange As Range

    ForEach objTable In ActiveDocument.Tables

    For Each objCell In objTable.Range.Cells

    Set objRange = objCell.Range
    objRange.End = objRange.End - 1

    Dim cellvalue As String

    'Enter textinside quotation marks
    If InStr(objRange, "WXYZ:")Then


    objTable.Range.Font.Name ="Arial"
    objTable.Range.Font.Size = 8
    objTable.Range.Font.ColorIndex =wdAuto
    objTable.Rows.AllowBreakAcrossPages =False
    objTable.Rows.Alignment =wdAlignRowCenter
    objTable.Rows.HeightRule =wdRowHeightAuto
    objTable.Rows.Borders.InsideLineStyle= wdLineStyleSingle
    objTable.Rows.Borders.InsideLineWidth= wdLineWidth050pt
    objTable.Rows.Borders.OutsideLineStyle = wdLineStyleSingle
    objTable.Rows.Borders.OutsideLineWidth = wdLineWidth150pt
    objTable.Rows.Borders.InsideColor =wdColorBlack

    objTable.AutoFitBehavior(wdAutoFitContent)
    objTable.PreferredWidthType =wdPreferredWidthPercent
    objTable.PreferredWidth = 100

    objTable.Rows(1).Shading.BackgroundPatternColor = wdColorDarkBlue
    objTable.Rows(1).Range.Font.Bold =True
    objTable.Rows(1).Range.ParagraphFormat.Alignment =wdAlignParagraphCenter
    objTable.Rows(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter

    End If

    Next

    Next

    Application.ScreenUpdating = True
    Application.ScreenRefresh
    Selection.HomeKey Unit:=wdStory
    MsgBox "Done!", vbInformation

    EndSub


















  2. #2
    You can use the same range to search for both texts, assuming both are in row 1, which cuts the processing down by half e.g. as follows. This will work provided there are no merged cells.

    Sub Table_Format()Dim objTable As Table
    Dim objCell As Cell
    Dim objRange As Range
    Dim cellvalue As String
        'Enter texts inside quotation marks
    Const strFind1 As String = "ABCD"
    Const strFind2 As String = "WXYZ:"
    
    
        Application.ScreenUpdating = False
        For Each objTable In ActiveDocument.Tables
            For Each objCell In objTable.Range.Rows(1).Cells
                Set objRange = objCell.Range
                objRange.End = objRange.End - 1
                If InStr(objRange, strFind1) Then
                    objTable.Range.Font.Name = "Arial"
                    objTable.Range.Font.Size = 8
                    objTable.Range.Font.ColorIndex = wdAuto
                    objTable.Rows.AllowBreakAcrossPages = False
                    objTable.Rows.Alignment = wdAlignRowCenter
                    objTable.Rows.HeightRule = wdRowHeightAuto
                    objTable.Rows.Borders.InsideLineStyle = wdLineStyleSingle
                    objTable.Rows.Borders.InsideLineWidth = wdLineWidth050pt
                    objTable.Rows.Borders.OutsideLineStyle = wdLineStyleSingle
                    objTable.Rows.Borders.OutsideLineWidth = wdLineWidth150pt
                    objTable.Rows.Borders.InsideColor = wdColorBlack
    
    
                    objTable.AutoFitBehavior (wdAutoFitContent)
                    objTable.PreferredWidthType = wdPreferredWidthPercent
                    objTable.PreferredWidth = 100
    
    
                    objTable.Columns(1).Shading.BackgroundPatternColor = wdColorGray10
                    objTable.Columns(1).Select
                    Selection.Font.Bold = True
                    Exit For
                End If
                If InStr(objRange, strFind2) Then
                    objTable.Range.Font.Name = "Arial"
                    objTable.Range.Font.Size = 8
                    objTable.Range.Font.ColorIndex = wdAuto
                    objTable.Rows.AllowBreakAcrossPages = False
                    objTable.Rows.Alignment = wdAlignRowCenter
                    objTable.Rows.HeightRule = wdRowHeightAuto
                    objTable.Rows.Borders.InsideLineStyle = wdLineStyleSingle
                    objTable.Rows.Borders.InsideLineWidth = wdLineWidth050pt
                    objTable.Rows.Borders.OutsideLineStyle = wdLineStyleSingle
                    objTable.Rows.Borders.OutsideLineWidth = wdLineWidth150pt
                    objTable.Rows.Borders.InsideColor = wdColorBlack
    
    
                    objTable.AutoFitBehavior (wdAutoFitContent)
                    objTable.PreferredWidthType = wdPreferredWidthPercent
                    objTable.PreferredWidth = 100
    
    
                    objTable.Rows(1).Shading.BackgroundPatternColor = wdColorDarkBlue
                    objTable.Rows(1).Range.Font.Bold = True
                    objTable.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                    objTable.Rows(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
                    Exit For
                End If
            Next
        Next
        Application.ScreenUpdating = True
        Application.ScreenRefresh
        Selection.HomeKey Unit:=wdStory
        MsgBox "Done!", vbInformation
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Apr 2018
    Posts
    8
    Location
    Mr. Mayor,
    It works like a charm (and faster)! It is perfect. Thank you, thank you, thank you!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •