vba关于vba userform的信息网格

我想把一个| 分隔网格成用户窗体。 这是我的:

 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 

以上做的正是我想要的即时窗口,但结果不alignment在用户窗体中:

在这里输入图像说明

这就是我在即时窗口中得到的,这是我在用户表单中预期/想要的:

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

编辑1:find这个完全不同的方法在网上的地方。 还在搞清楚,如果我能做到我想要的(一个很好的网格与标题等),虽然:

 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 

您需要使用像Courier NewConsolas这样的单色空间字体。 将其设置为像这样的标签:

 frmBigInputBox.lblBig.Font = "Courier New"