Fixed Width Columns in VBA Text Box

Question

For Each cell In wb.Sheets("RP Analysis").Range("F5:F" & lastRow)
    structure = "Layer " & WorksheetFunction.RoundDown(cell.Value, 2) & ": " & WorksheetFunction.RoundDown(cell.Offset(0, 2).Value / 1000000, 2) & " xs " & WorksheetFunction.RoundDown(cell.Offset(0, 3).Value / 1000000, 2) & " attaches at "
    RMS = RMS & structure & WorksheetFunction.RoundDown(cell.Offset(0, 10).Value, 2) & "m and exhausts at " & WorksheetFunction.RoundDown(cell.Offset(0, 11).Value, 2) & "m" & vbLf
    AIR = AIR & structure & WorksheetFunction.RoundDown(cell.Offset(0, 6).Value, 2) & "m and exhausts at " & WorksheetFunction.RoundDown(cell.Offset(0, 7).Value, 2) & "m" & vbLf
Next cell

For Each cell In wb.Sheets("RP Analysis").Range("A9:A" & 19)
        gucurve = gucurve & cell.Value & ":-   " & Format(cell.Offset(0, 2).Value / cell.Offset(0, 1).Value, "Percent") & vbLf
Next cell

TextBox1.Value = "RP years    RMS/AIR difference" & vbLf & gucurve & vbLf & "AIR" & vbLf & AIR & vbLf & "RMS" & vbLf & RMS

It creates

  Layer 1: 25 xs 50 attaches at 8.16m and exhausts at 10.4m
  Layer 2: 100 xs 75 attaches at 10.4m and exhausts at 20.15m
  Layer 3: 44 xs 175 attaches at 20.15m and exhausts at 24.96m
  Layer 4: 144 xs 175 attaches at 20.15m and exhausts at 34.86m

I want him to produce

  Layer 1: 25 xs  50 attaches at  8.16m and exhausts at  10.4m
  Layer 2:100 xs  75 attaches at  10.4m and exhausts at 20.15m
  Layer 3: 44 xs 175 attaches at 20.15m and exhausts at 24.96m
  Layer 4:144 xs 175 attaches at 20.15m and exhausts at 34.86m

So I think that I need fixed columns with a certain width with everything in the center. Numbers will not exceed 4 digits

How should I do it?

Answer 1

One way is to create your own function that returns strings of fixed length. Below is a line and prefixes with as many spaces as necessary to achieve the required length. Oversized lines are not trimmed, but if necessary it will be a simple change.

Public Function Pad(ByVal OriginalString As String, ByVal RequiredLength As Integer) As String
' Prefixes the passed string with spaces, to return a fixed width string.

    ' Check padding required.
    If RequiredLength > Len(OriginalString) Then

        ' Required, prefix with spaces.
        Pad = Space(RequiredLength - Len(OriginalString)) & OriginalString
    Else

        ' Padding not required, return original value.
        Pad = OriginalString
    End If
End Function

You would call this function as follows:

..."Layer " & Pad(WorksheetFunction.RoundDown(cell.Value, 2), 10) &...

EDIT

@ . , . ; /. , VBA .

Public Function Pad(ByVal OriginalString As String, ByVal RequiredLength As Integer) As String
' Prefixes the passed string with spaces, to return a fixed width string.

    Pad = Format(OriginalString, String(RequiredLength, "@"))
End Function

Answer 2

Format @ :

Format("123", "@@@@@@@@@@")     ' returns "       123"

:

Format("123", "!@@@@@@@@@@")    ' returns "123       "

:

Format("123", String(25, "@"))  ' returns "                      123"

Answer 3

, - . , = LSet. RSet. , , , , .

:

Private Function ToColumns(layer As Long, percent As Long, xs As Long, attach As Double, _
                           exhaust As Double) As String
    Dim col1 As String * 1      'Change the widths here to adjust your columns.
    Dim col2 As String * 3
    Dim col3 As String * 3
    Dim col4 As String * 5
    Dim col5 As String * 5

    RSet col1 = layer
    RSet col2 = percent
    RSet col3 = xs
    RSet col4 = Format$(attach, "#.##")
    RSet col5 = Format$(exhaust, "#.##")

    ToColumns = "Layer " & col1 & ":" & _
                col2 & " xs " & _
                col3 & " attaches at " & _
                col4 & "m and exhausts at " & _
                col5 & "m"
End Function

:

Debug.Print ToColumns(1, 25, 50, 8.16, 10.4)
Debug.Print ToColumns(2, 100, 75, 10.4, 20.15)

:

Layer 1: 25 xs  50 attaches at  8.16m and exhausts at  10.4m
Layer 2:100 xs  75 attaches at  10.4m and exhausts at 20.15m

, , , , .

Answer 4

:

, , , , . , .

: TrueType, Microsoft,

The only TrueType monospace fonts provided by Microsoft are Courier New, which ships with Windows 3.1, and Lucida Sans Typewriter, which was included in the TrueType Font Pack. All other TrueType fonts included with Windows 3.1 and TrueType Font Pack are proportional fonts.