我想将|
分隔的网格放入用户表单中。这就是我所拥有的:
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
以上内容完全符合我想要的即时窗口,但结果未在userform中对齐:
以下是我在即时窗口中获得的内容,这是我在userform中所期望/想要的内容:
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
答案 0 :(得分:1)
您需要使用Courier New
或Consolas
等单位空格字体。像标签一样设置它:
frmBigInputBox.lblBig.Font = "Courier New"