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

问题描述：

我想将一个|分隔网格放入用户窗体中。这是我有：vba关于标签中的vba用户表单的信息网格

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

答

你需要使用一个单空间字体像Courier New或Consolas。将其设置为像这样的标签：

frmBigInputBox.lblBig.Font = "Courier New"

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

相关推荐