vb.net Word Table Formatting - vb.net

Question

I have been trying to figure out how to force word tables to under line until the end of the cell. I appear to be having issues if lines are to long and/or to short. I am not a word expert, however I am assuming that all characters are not the same size...
This is what the code produces
Below is the code I used to create the above. I would think that I should be able to check the cell length? Any help would be appreciated.
Public Shared Sub CreateWordDocument()
Try
Dim oWord As Word.Application
Dim oDoc As Word.Document
'Start Word and open the document template.
oWord = CreateObject("Word.Application")
oWord.Visible = True
oDoc = oWord.Documents.Add
Dim Row As Integer, Column As Integer
Dim myTable As Word.Table = oDoc.Tables.Add(oDoc.Bookmarks.Item("\endofdoc").Range, 10, 2)
myTable.Range.ParagraphFormat.SpaceAfter = 1
Dim mystring As String = "This is my Test name That Runs over to the next line"
Dim address1 As String = "123 1st fake street"
Dim address2 As String = "Fake town place"
Dim mystring2 As String = "This is good line"
Dim address3 As String = "321 3rd fake street"
Dim address4 As String = "Fake town place"
Dim line As String = "_"
For Row = 1 To 10
If Row <> 5 Then
myTable.Rows.Item(Row).Range.Font.Underline = Word.WdUnderline.wdUnderlineSingle
myTable.Rows.Item(Row).Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
myTable.Rows.Item(Row).Range.Font.Bold = False
myTable.Rows.Item(Row).Range.Font.Size = 11
myTable.Rows.Item(Row).Range.Font.Underline = Word.WdUnderline.wdUnderlineSingle
End If
For Column = 1 To 2
If Column = 1 And Row = 1 Then
myTable.Cell(Row, Column).Range.Text = GetString(mystring)
ElseIf Column = 1 And Row = 2 Then
myTable.Cell(Row, Column).Range.Text = GetString(address1)
ElseIf Column = 1 And Row = 3 Then
myTable.Cell(Row, Column).Range.Text = GetString(address2)
ElseIf Column = 2 And Row = 1 Then
myTable.Cell(Row, Column).Range.Text = GetString(mystring2)
ElseIf Column = 2 And Row = 2 Then
myTable.Cell(Row, Column).Range.Text = GetString(address3)
ElseIf Column = 2 And Row = 3 Then
myTable.Cell(Row, Column).Range.Text = GetString(address4)
Else
myTable.Cell(Row, Column).Range.Text = GetString(line)
End If
Next
Next
Dim strCellText As String
Dim uResp As String
Dim itable As Table
For Each itable In oDoc.Tables
uResp = ""
For Row = 1 To itable.Rows.Count
For Col = 1 To itable.Columns.Count
strCellText = itable.Cell(Row, Col).Range.Text
If strCellText.Length >= 33 Then
Console.Write("this will be on a different line")
ElseIf strCellText.Length <= 31 Then
Console.Write("this will be on a different line")
End If
Next
Next
Next
Catch ex As Exception
End Try
End Sub
Public Shared Function GetString(ByVal strGetLine As String) As String
If strGetLine.Length <> 30 Then
Do Until strGetLine.Length >= 30
strGetLine += "_"
Dim count As String = strGetLine.Length
Loop
End If
Return strGetLine
End Function

Answer 1

There are two parts to your problem. One is the font. Because you are padding each line with "_" to a predetermined width, you must use a monospaced font or the lines will end unevenly. With a monospaced font, each character will take up the same width which will give you your uniform lines. Second, the GetString function takes any line less than 30 characters and pads it, but it does not handle any lines that are over 30 characters which is why the line wraps by itself. To solve these two problems, I set the font to a monospaced font (Courier New in this case) and modified the GetString function's logic. Now, if the line is more than 30 characters, the function will find a space where it can split the string as close as possible to the 30-char limit and add a break there, before padding both lines with underscores. Here is your code with the changes included:
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Added these two Dim's so I could run your example
Dim oWord As Object
Dim oDoc As Document
oWord = CreateObject("Word.Application")
oWord.Visible = True
oDoc = oWord.Documents.Add
Dim Row As Integer, Column As Integer
Dim myTable As Word.Table = oDoc.Tables.Add(oDoc.Bookmarks.Item("\endofdoc").Range, 10, 2)
myTable.Range.ParagraphFormat.SpaceAfter = 1
Dim mystring As String = "This is my Test name That Runs over to the next line"
Dim address1 As String = "123 1st fake street"
Dim address2 As String = "Fake town place"
Dim mystring2 As String = "This is good line"
Dim address3 As String = "321 3rd fake street"
Dim address4 As String = "Fake town place"
Dim line As String = "_"
For Row = 1 To 10
'Removed this If, because all lines need font set to ensure same width, even if line has no text
'If Row <> 5 Then
myTable.Rows.Item(Row).Range.Font.Underline = Word.WdUnderline.wdUnderlineSingle
myTable.Rows.Item(Row).Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
myTable.Rows.Item(Row).Range.Font.Bold = False
myTable.Rows.Item(Row).Range.Font.Size = 11
myTable.Rows.Item(Row).Range.Font.Underline = Word.WdUnderline.wdUnderlineSingle
myTable.Rows.Item(Row).Range.Font.Name = "Courier New" 'Set font to a monospaced font
'End If
For Column = 1 To 2
If Column = 1 And Row = 1 Then
myTable.Cell(Row, Column).Range.Text = GetString(mystring)
ElseIf Column = 1 And Row = 2 Then
myTable.Cell(Row, Column).Range.Text = GetString(address1)
ElseIf Column = 1 And Row = 3 Then
myTable.Cell(Row, Column).Range.Text = GetString(address2)
ElseIf Column = 2 And Row = 1 Then
myTable.Cell(Row, Column).Range.Text = GetString(mystring2)
ElseIf Column = 2 And Row = 2 Then
myTable.Cell(Row, Column).Range.Text = GetString(address3)
ElseIf Column = 2 And Row = 3 Then
myTable.Cell(Row, Column).Range.Text = GetString(address4)
Else
myTable.Cell(Row, Column).Range.Text = GetString(line)
End If
Next
Next
Dim strCellText As String
Dim uResp As String
Dim itable As Table
For Each itable In oDoc.Tables
uResp = ""
For Row = 1 To itable.Rows.Count
For Col = 1 To itable.Columns.Count
strCellText = itable.Cell(Row, Col).Range.Text
If strCellText.Length >= 33 Then
Console.Write("this will be on a different line")
ElseIf strCellText.Length <= 31 Then
Console.Write("this will be on a different line")
End If
Next
Next
Next
End Sub
Public Shared Function GetString(ByVal strGetLine As String) As String
'If strGetLine.Length <> 30 Then
' Do Until strGetLine.Length >= 30
' strGetLine += "_"
' Dim count As String = strGetLine.Length
' Loop
'End If
'New Function Logic:
'If the line is just a blank line, then just send back 30 underscores
If strGetLine.Trim.Equals("_") Then Return strGetLine.PadRight(30, "_")
Dim ret As String = Nothing
If strGetLine.Length > 30 Then
Dim lineBreak As Integer = 0
If strGetLine.Length >= 30 Then
Dim i As Integer = 0
Do While i <= 30
i = strGetLine.IndexOf(" ", i + 1)
If i <= 30 Then lineBreak = i
Loop
End If
ret = strGetLine.Substring(0, lineBreak).Trim.PadRight(30, "_") & vbCrLf
ret &= strGetLine.Substring(lineBreak, strGetLine.Length - lineBreak).Trim.PadRight(30, "_")
Else
ret = strGetLine.PadRight(30, "_")
End If
Return ret
End Function
Which outputs:
Now I'm sure you'll notice, there appears to be a blank line in the right column (the rest of the blank lines are from the 10 row loop). This is simply because the other column of the same row has two lines. I don't know if that's what you would want or not, but if you want both columns to have the appearance of the same number of lines, you will have to keep track of if you split a line in column 1, and add an extra blank line to column two...but this should get you going in the right direction