2017-09-11 14 views
0

我想將一個|分隔網格放入用戶窗體中。這是我有: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 

以上不正是我想在不久的窗口,但結果不會在用戶窗體對齊:

enter image description here

以下是我在得到眼前的窗口,這是我預期/希望在用戶窗體:

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 

回答

1

你需要使用一個單空間字體像Courier NewConsolas。將其設置爲像這樣的標籤:

frmBigInputBox.lblBig.Font = "Courier New"