标签中关于 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

上面的内容在即时窗口中完全符合我的要求，但结果在用户窗体中没有对齐：

这是我在即时窗口中得到的，这是我在用户表单中所期望/想要的：

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

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

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

您需要使用像Courier New 或Consolas 这样的等宽字体。像这样为标签设置它：

frmBigInputBox.lblBig.Font = "Courier New"