Answered by:
Select the first row of each cell in a table and Bold it. Leaving the rest of the cell normal

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
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.- Marked as answer by Luna Zhang - MSFT Friday, June 20, 2014 7:17 AM
- Edited by Luna Zhang - MSFT Friday, June 20, 2014 7:25 AM
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.- Marked as answer by Luna Zhang - MSFT Friday, June 20, 2014 7:17 AM
- Edited by Luna Zhang - MSFT Friday, June 20, 2014 7:25 AM
-
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 WithSet 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 WithSet wdTbl = wdDoc.Tables.Add(Range:=wdDoc.Range(Start:=0, End:=0), _
NumRows:=lRow + 1, NumColumns:=3) ' adds a table with three columns and speWith 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 SubNote 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]