none
Select the first row of each cell in a table and Bold it. Leaving the rest of the cell normal RRS feed

  • Question

  • Hello,

    I have designed a program to pull a column Concatenated data from excel and paste it into two columns in Word. I am looking to have the first row in each cell bold and the rest of the cell to be normal. Below is my code, with the part I have attempt to bold the first 18 characters (thats how many characters are in each row). Could Someone help me out?

    Sub Drawings()
    
    Dim WordApp As Word.Application
    Dim oDoc As Word.Document
    Dim myRange As Word.Range
    Dim RowCount
    Dim RowNumber
    Dim Row
    Dim rng As Range
    
    Set rng = ActiveCell
    
    RowCount = Application.CountA(Range("A:A"))
    RowNumber = Round(RowCount / 2)
    
    Set WordApp = CreateObject("Word.Application") ' creates the Woord Applications
    WordApp.Visible = True ' allows the word window to be open
    
    Set oDoc = WordApp.Documents.Add ' WordDoc is the variable to edit the document
    
    Set otable = oDoc.Tables.Add( _
        Range:=oDoc.Range(Start:=0, End:=0), NumRows:=RowNumber + 1, _
        NumColumns:=3) ' adds a table with three columns and spe
    
    oDoc.Tables(1).Columns(1).SetWidth ColumnWidth:=WordApp.CentimetersToPoints(10.1), RulerStyle:=wdAdjustNone ' sets column 1 to 4 inches
    oDoc.Tables(1).Columns(2).SetWidth ColumnWidth:=WordApp.CentimetersToPoints(0.45), RulerStyle:=wdAdjustNone ' sets column 2 to .2 inches
    oDoc.Tables(1).Columns(3).SetWidth ColumnWidth:=WordApp.CentimetersToPoints(10.1), RulerStyle:=wdAdjustNone ' sets column 3 to 4 inches
    
    
    With oDoc.PageSetup
    .LeftMargin = WordApp.CentimetersToPoints(0.2)  ' sets left margin
    .RightMargin = WordApp.CentimetersToPoints(0.5)  ' sets right margin
    .TopMargin = WordApp.CentimetersToPoints(0.5) 'sets top margin
    .BottomMargin = WordApp.CentimetersToPoints(0.5) ' sets bottom margin
    End With
    
     'Loop through columns and rows
       For iRow = 2 To RowNumber
        For iCol = 1 To 1 ' takes data from column 1
            With Worksheets("Sheet1").Cells(iRow, iCol)
                otable.Rows(iRow - 1).Cells(1).Range.Text = .Value
            End With
        Next iCol
        Next iRow
        
        For iRow = RowNumber + 1 To RowCount
         For iCol = 1 To 1 ' takes data from column 1
                With Worksheets("Sheet1").Cells(iRow, iCol)
                otable.Rows(iRow - RowNumber).Cells(3).Range.Text = .Value
            End With
        
        Next iCol
        Next iRow
       
    With otable
        .Rows.HorizontalPosition = WordApp.CentimetersToPoints(0.5)  ' shifts left up on the page
        .Rows.VerticalPosition = WordApp.CentimetersToPoints(0.75) ' shifts down up on the page
    
    End With
        
        WordApp.Selection.WholeStory ' selects the entire table
        'WordApp.Selection.Font.Bold = wdToggle ' bolds the text
        WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 'center aligns everything
        WordApp.Selection.Font.Size = 13.7
        
        
        With otable
        For Each MyCell In Range("A:B") ' step through each cell in the table
            WordApp.Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend ' select first 18 characters of cell
            WordApp.Selection.Font.Bold = wdToggle ' bold the selected characters
        Next MyCell ' move to next cell
        End With
        
        WordApp.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
        oDoc.Tables(1).Rows.HeightRule = wdRowHeightExactly ' ensures row height is exact
        oDoc.Tables(1).Rows.Height = WordApp.InchesToPoints(1) ' sets all rows to 1 inch
    
    End Sub

    Thanks


    • Edited by electech5 Friday, June 13, 2014 8:01 PM
    Friday, June 13, 2014 6:09 PM

Answers

  • Hi,

    >>I am looking to have the first row in each cell bold and the rest of the cell to be normal. Below is my code, with the part I have attempt to bold the first 18 characters (thats how many characters are in each row).<<

    According to the code your provided, I don't understand why you need to loop through all cells in the Range("A:B") of the workbook but you said "step through each cell in the table".

    With otable
        For Each MyCell In Range("A:B") ' step through each cell in the table
            WordApp.Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend ' select first 18 characters of cell
            WordApp.Selection.Font.Bold = wdToggle ' bold the selected characters
        Next MyCell ' move to next cell
        End With

    If you want to access to all cells in a table, you could refer to the code below.

    For Each  oRow  In  otable.Rows 
         For Each  oCell  In  oRow.Cells 
             'operate oCell
         Next oCell 
     Next oRow 

    To bold the first row (first 18 characters) in a cell of table, you could refer to the bold part in the code below. In the code, it will bold the first 18 characters in each cell of column 1 and 3. You could edit it as you want to achieve the goal.

        'With otable
        'For Each MyCell In Range("A:B") ' step through each cell in the table
            'WordApp.Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend ' select first 18 characters of cell
            'WordApp.Selection.Font.Bold = wdToggle ' bold the selected characters
        'Next MyCell ' move to next cell
        'End With
    
        WordApp.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
        oDoc.Tables(1).Rows.HeightRule = wdRowHeightExactly ' ensures row height is exact
        oDoc.Tables(1).Rows.Height = WordApp.InchesToPoints(1) ' sets all rows to 1 inch
    
        For Each oRow In otable.Rows
            For Each MyCell In oRow.Cells
                If MyCell.ColumnIndex <> 2 Then
                    MyCell.Select
                    WordApp.Selection.Collapse wdCollapseStart
                    WordApp.Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend ' select first 18 characters of cell
                    WordApp.Selection.Font.Bold = wdToggle ' bold the selected characters
                End If
            Next MyCell
        Next oRow
        
    End Sub


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, June 16, 2014 8:59 AM
    Moderator

All replies

  • Hi,

    >>I am looking to have the first row in each cell bold and the rest of the cell to be normal. Below is my code, with the part I have attempt to bold the first 18 characters (thats how many characters are in each row).<<

    According to the code your provided, I don't understand why you need to loop through all cells in the Range("A:B") of the workbook but you said "step through each cell in the table".

    With otable
        For Each MyCell In Range("A:B") ' step through each cell in the table
            WordApp.Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend ' select first 18 characters of cell
            WordApp.Selection.Font.Bold = wdToggle ' bold the selected characters
        Next MyCell ' move to next cell
        End With

    If you want to access to all cells in a table, you could refer to the code below.

    For Each  oRow  In  otable.Rows 
         For Each  oCell  In  oRow.Cells 
             'operate oCell
         Next oCell 
     Next oRow 

    To bold the first row (first 18 characters) in a cell of table, you could refer to the bold part in the code below. In the code, it will bold the first 18 characters in each cell of column 1 and 3. You could edit it as you want to achieve the goal.

        'With otable
        'For Each MyCell In Range("A:B") ' step through each cell in the table
            'WordApp.Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend ' select first 18 characters of cell
            'WordApp.Selection.Font.Bold = wdToggle ' bold the selected characters
        'Next MyCell ' move to next cell
        'End With
    
        WordApp.Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
        oDoc.Tables(1).Rows.HeightRule = wdRowHeightExactly ' ensures row height is exact
        oDoc.Tables(1).Rows.Height = WordApp.InchesToPoints(1) ' sets all rows to 1 inch
    
        For Each oRow In otable.Rows
            For Each MyCell In oRow.Cells
                If MyCell.ColumnIndex <> 2 Then
                    MyCell.Select
                    WordApp.Selection.Collapse wdCollapseStart
                    WordApp.Selection.MoveRight Unit:=wdCharacter, Count:=18, Extend:=wdExtend ' select first 18 characters of cell
                    WordApp.Selection.Font.Bold = wdToggle ' bold the selected characters
                End If
            Next MyCell
        Next oRow
        
    End Sub


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, June 16, 2014 8:59 AM
    Moderator
  • Try:

    Sub Drawings()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdRng As Word.Range
    Dim wdTbl As Word.Table
    Dim iRow As Long, lRow As Long
    Dim xlWkSht As Worksheet
    Set xlWkSht = Worksheets("Sheet1")

    With xlWkSht.UsedRange
      lRow = Int(.Range("A" & .Rows.Count).End(xlUp).Row / 2)
    End With

    Set wdApp = CreateObject("Word.Application") ' creates the Word Applications

    Set wdDoc = wdApp.Documents.Add ' WordDoc is the variable to edit the document

    With wdDoc.PageSetup
      .LeftMargin = wdApp.CentimetersToPoints(0.2)  ' sets left margin
      .RightMargin = wdApp.CentimetersToPoints(0.5)  ' sets right margin
      .TopMargin = wdApp.CentimetersToPoints(0.5) 'sets top margin
      .BottomMargin = wdApp.CentimetersToPoints(0.5) ' sets bottom margin
    End With

    Set wdTbl = wdDoc.Tables.Add(Range:=wdDoc.Range(Start:=0, End:=0), _
        NumRows:=lRow + 1, NumColumns:=3) ' adds a table with three columns and spe

    With wdTbl
      .Columns(1).SetWidth ColumnWidth:=wdApp.InchesToPoints(4), RulerStyle:=wdAdjustNone ' sets column 1 to 4 inches
      .Columns(2).SetWidth ColumnWidth:=wdApp.InchesToPoints(0.2), RulerStyle:=wdAdjustNone ' sets column 2 to .2 inches
      .Columns(3).SetWidth ColumnWidth:=wdApp.InchesToPoints(4), RulerStyle:=wdAdjustNone ' sets column 3 to 4 inches
      With .Rows
        .HorizontalPosition = wdApp.CentimetersToPoints(0.5)  ' shifts left up on the page
        .VerticalPosition = wdApp.CentimetersToPoints(0.75) ' shifts down up on the page
        .HeightRule = wdRowHeightExactly ' ensures row height is exact
        .Height = wdApp.InchesToPoints(1) ' sets all rows to 1 inch
      End With
      With .Range
        .ParagraphFormat.Alignment = wdAlignParagraphCenter 'center aligns everything
        .Font.Size = 13.5
        .Cells.VerticalAlignment = wdCellAlignVerticalCenter
      End With
      .Rows(1).Range.Font.Bold = True
    End With

    'Loop through columns and rows
    For iRow = 2 To lRow
      wdTbl.Rows(iRow - 1).Cells(1).Range.Text = xlWkSht.Cells(iRow, 1).Value
      wdTbl.Rows(iRow - 1).Cells(3).Range.Text = xlWkSht.Cells(iRow * 2, 1).Value
    Next iRow

    ' Show the Word window
    wdApp.Visible = True
    wdApp.Activate
    End Sub

    Note that I've streamlined the code somewhat. For example, your 'For iCol = 1 To 1' code does nothing useful.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, June 17, 2014 4:27 AM