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