vb.net Word Table Formatting

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