vba 标签中 vba 用户表单的信息网格

Question

我想将 | 分隔的网格放入用户表单中。这是我的：

Sub test()

Dim x
x = getInputFromGrid("some text at the top: " & vbCr & "hrd1 | hrd2" & vbCr & "information1 | my long information2" & vbCr)


End Sub

Function getInputFromGrid(prompt As String) As String

    Dim Counter As Integer




Dim asByLine() As String
asByLine = Split(prompt, Chr(13))
Dim asByCol() As String

Dim asMxLenByCol() As Integer
ReDim asMxLenByCol(0 To 0)
Dim sNewPrompt As String
Dim c As Integer
Dim l As Integer
For l = 0 To UBound(asByLine)
    If InStr(1, asByLine(l), " | ") > 0 Then

        asByCol = Split(asByLine(l), " | ")

        ReDim Preserve asMxLenByCol(0 To UBound(asByCol))

        For c = 0 To UBound(asByCol)
            If asMxLenByCol(c) < Len(asByCol(c)) Then
                asMxLenByCol(c) = Len(asByCol(c))
            End If
        Next c

    End If
Next l


Dim iAddSp As Integer
For l = 0 To UBound(asByLine)
    If InStr(1, asByLine(l), " | ") > 0 Then
        asByCol = Split(asByLine(l), " | ")
        For c = 0 To UBound(asByCol)

            Do While asMxLenByCol(c) > Len(asByCol(c))
                asByCol(c) = asByCol(c) & " "
            Loop

            sNewPrompt = sNewPrompt & asByCol(c) & " | "
'Debug.Print sNewPrompt
        Next c
        sNewPrompt = sNewPrompt & vbCr
    Else
        sNewPrompt = sNewPrompt & asByLine(l) & vbCr
    End If
'Debug.Print sNewPrompt
Next l
Debug.Print sNewPrompt '<- looks good in immediate windows
    frmBigInputBox.lblBig.Caption = sNewPrompt
    frmBigInputBox.Show
    getInputFromGrid = frmBigInputBox.tbStuff.Text
End Function

上面的内容完全符合我的要求window，但结果在用户表单中没有对齐：

这是我在 window 中立即得到的，这是我 expected/want 在用户表单中得到的：

some text at the top: 
hrd1         | hrd2                 | 
information1 | my long information2 |

编辑 1：在某个地方在线找到了这种完全不同的方法。仍在弄清楚我是否可以让它做我想做的事（一个漂亮的网格 headers 等）虽然：

Option Explicit
Sub test()

UserForm1.Show
End Sub
Private Sub UserForm_Initialize()

    Dim totalHeight As Long
    Dim rowHeight As Double
    Dim lbl As MSForms.Label
    Dim x As Long
    Const dateLabelWidth As Long = 100
    Dim dataLabelWidth As Double
    dataLabelWidth = (Me.Frame1.Width - dateLabelWidth) - 16 'Full width less scrollbar

    With Me.Frame1
        For x = 0 To 100
            Set lbl = .Controls.Add("Forms.label.1") 'Data
            With lbl
                .Caption = String(x * 10, "x")
                .Top = totalHeight
                .BackColor = &H80000014
                .Left = dateLabelWidth
                .BorderStyle = 1
                .BorderColor = &H8000000F
                .Width = dataLabelWidth
                rowHeight = autoSizeLabel(lbl)
                If lbl.Width < dataLabelWidth Then lbl.Width = dataLabelWidth
            End With
            With .Controls.Add("Forms.Label.1") 'Date
                .Width = dateLabelWidth
                .Caption = "12 Apr 2016"
                .Top = totalHeight
                .Height = rowHeight
                .BackColor = &H80000014
                .Left = 0
                .BorderStyle = 1
                .BorderColor = &H8000000F
            End With

            totalHeight = totalHeight + rowHeight

        Next x
        .BackColor = &H80000014
        .ScrollBars = fmScrollBarsVertical
        .ScrollHeight = totalHeight
    End With

End Sub


Private Function autoSizeLabel(ByVal lbl As MSForms.Label) As Double
    lbl.AutoSize = False
    lbl.AutoSize = True
    lbl.Height = lbl.Height + 10
    autoSizeLabel = lbl.Height

End Function

Answer 1

您需要使用单色 space 字体，例如 Courier New 或 Consolas。像这样为标签设置它：

frmBigInputBox.lblBig.Font = "Courier New"

vba 标签中 vba 用户表单的信息网格

vba grid of information on vba userform in a label

excel

vba

label

userform