coder32 coder32 - 1 month ago 10
Vb.net Question

vb.net Word Table Formatting

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...

enter image description here

This is what the code produces

enter image description here

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

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:

Line Test

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