Quantcast
Channel: General Office Development forum
Viewing all articles
Browse latest Browse all 2257

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

$
0
0

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



Viewing all articles
Browse latest Browse all 2257

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>