Hi guys
Please excuse me for posting new thread which is in continuation of thread 43109
somehow successful with new oCell2 as object to get values of 2 column with respective textboxes
I am attaching the Docx File for your refernce
Page 1 of docx file represents what i desire
Page 2 of docx file explains in details with coding Explains where proper spacing required with vbCrlf between two Paragraphs (as spacing will take size 15 of between two lines/Paragraphs) and adding new table at a diffrent position shown in file attached
Code:
Private Sub CommandButton1_Click()
''''''''''''Private Sub cmdWordformat_Click()
Dim objWord As Object
Dim txtword As String, sh As Worksheet
Dim objDoc As Object
Dim objRange As Object
Dim objTable As Object, objTable2 As Object
Dim intRows As Integer
Dim intCols As Integer
Dim oCell As Object, oCell2 As Object, oCellT2 As Object
txtword = "To," & vbCrLf & "Add1," & vbCrLf & "Add2" & vbCrLf & "Add3" & vbCrLf & _
"Date : " & TextBox1.Text & vbCrLf & vbCrLf & " " & TextBox2.Text & vbCrLf & _
"Sub : " & vbCrLf & vbCrLf & "Dear Sir/Madam" & vbCrLf & _
" " & TextBox3.Text & " With a request to fdljfljdljf kdfhdfhdhfdfhd" & vbCrLf & _
"sjfhksdfhdskfhdsfkds / XXX. hbxczkdhsakdhsdjshkdjsh."
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err Then
Set objWord = CreateObject("Word.Application")
End If
On Error GoTo 0
Set objDoc = objWord.Documents.Add
objWord.Visible = True
objWord.ActiveDocument.Range.Font.Name = "Tahoma"
objWord.ActiveDocument.Range.Font.Size = "15"
objWord.ActiveDocument.Paragraphs.SpaceAfter = 0 'As this syntax for all matter in document with ZERO Space
Set objRange = objDoc.Range
With objRange
.Text = txtword & vbCr & vbNewLine 'add the paragraph break at the end of the text string
.Collapse Direction:=0
End With
intRows = 8: intCols = 2
Set objTable = objDoc.Tables.Add(objRange, intRows, intCols)
With objTable
.Borders.Enable = True
Set oCell = .Cell(1, 1).Range
oCell.End = oCell.End - 1
oCell.Text = "Row1"
oCell.Bold = True
Set oCell = .Cell(2, 1).Range
oCell.End = oCell.End - 1
oCell.Text = "Row2"
Set oCell = .Cell(3, 1).Range
oCell.End = oCell.End - 1
oCell.Text = "Row3"
Set oCell = .Cell(4, 1).Range
oCell.End = oCell.End - 1
oCell.Text = "Row4"
Set oCell = .Cell(5, 1).Range
oCell.End = oCell.End - 1
oCell.Text = "Row5"
Set oCell = .Cell(6, 1).Range
oCell.End = oCell.End - 1
oCell.Text = "Row6"
Set oCell = .Cell(7, 1).Range
oCell.End = oCell.End - 1
oCell.Text = "Row7"
Set oCell = .Cell(8, 1).Range
oCell.End = oCell.End - 1
oCell.Text = "Row8"
Set oCell2 = .Cell(1, 2).Range
oCell2.End = oCell2.End - 1
oCell2.Text = txtRow1.Text
oCell2.Bold = True
Set oCell2 = .Cell(2, 2).Range
oCell2.End = oCell2.End - 1
oCell2.Text = txtRow2.Text
Set oCell2 = .Cell(3, 2).Range
oCell2.End = oCell2.End - 1
oCell2.Text = txtRow3.Text
Set oCell2 = .Cell(4, 2).Range
oCell2.End = oCell2.End - 1
oCell2.Text = txtRow4.Text
Set oCell2 = .Cell(5, 2).Range
oCell2.End = oCell2.End - 1
oCell2.Text = txtRow5.Text
Set oCell2 = .Cell(6, 2).Range
oCell2.End = oCell2.End - 1
oCell2.Text = txtRow6.Text
Set oCell2 = .Cell(7, 2).Range
oCell2.End = oCell2.End - 1
oCell2.Text = txtRow7.Text
Set oCell2 = .Cell(8, 2).Range
oCell2.End = oCell2.End - 1
oCell2.Text = txtRow8.Text
.Range.Font.Name = "Tahoma"
.Range.Font.Size = 15
End With
txtword = vbNewLine & " " & vbCrLf & _
" " & vbNewLine & vbNewLine & " " & vbNewLine & _
vbNewLine & "Yours Truly," & vbNewLine & vbNewLine & vbNewLine & vbNewLine & "(Authorised Signatory)" & vbNewLine & vbNewLine & _
"Contact No.: _____________________"
Set objRange = objDoc.Range
With objRange
.Collapse Direction:=0
.Text = txtword & vbCr 'add the paragraph break at the end of the text string
End With
Set objWord = Nothing
Set objDoc = Nothing
Set objRange = Nothing
Set objTable = Nothing
Set oCell = Nothing
Set objTable2 = Nothing
Set oCell2 = Nothing
Set oCellT2 = Nothing
End Sub
Thanks SamD