Josef Ehrensberger - Userform noch ein "Problem"

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Franc!
Ersetze diese zwei Prozeduren!

Private Sub setList()
Dim lngRow As Long, lngLast As Long, lngIndex As Long

lngLast = Cells(Rows.Count, 1).End(xlUp).Row

ListBox1.Clear

For lngRow = 2 To lngLast
  If Rows(lngRow).Hidden = False Then

    With ListBox1
      .AddItem Cells(lngRow, 1)
      .List(.ListCount - 1, 1) = Cells(lngRow, 3)
      .List(.ListCount - 1, 2) = Cells(lngRow, 7)
      .List(.ListCount - 1, 3) = Cells(lngRow, 9)
      .List(.ListCount - 1, 4) = Cells(lngRow, 10)
      .List(.ListCount - 1, 5) = Cells(lngRow, 14)
      .List(.ListCount - 1, 6) = Cells(lngRow, 15)
    End With

  End If
Next
If ListBox1.ListCount > 0 Then
  setColCountAndWidth ListBox1, ListBox1.List
End If
End Sub

Private Function setColCountAndWidth(ByRef theBox As Object, ByVal theList As Variant, _
  Optional setBoxWidth As Boolean = False)
'by Josef Ehrensberger (11/2005)
'######## PARAMETER ###########################################################
'~~~~~~~~~~~~~~~~~~~ theBox = List- oder Combo- Box in UF oder Tabelle
'~~~~~~~~~~~~~~~~~~~ theList = Die Liste als Array
'~~~~~~~~~~~~~~~~~~~ setBoxWidth = Breite der Box anpassen
'######## BEISPIEL ############################################################
'
' setColCountAndWidth Listbox1, myArray, True
'
' setColCountAndWidth ComboBox1, ComboBox1.List
'
' setColCountAndWidth Sheets(1).ComboBox1, Sheets(1).ComboBox1.List
'
'##############################################################################

Dim iCol As Integer, lRow As Long, dblMax As Double, dblWidth As Double
Dim objDummy As Object
Dim strColWidth As String

If TypeOf theBox.Parent Is MSForms.UserForm Then
  Set objDummy = theBox.Parent.Controls.Add("Forms.TextBox.1", "txtDummy", False)
ElseIf TypeOf theBox.Parent Is Worksheet Then
  Set objDummy = theBox.Parent.OLEObjects.Add(ClassType:="Forms.TextBox.1", Top:=0, _
    Left:=0, Width:=0, Height:=0)
Else
  Exit Function
End If

With objDummy
  .Visible = False
  .Object.Font.Name = theBox.Font.Name
  .Object.Font.Size = theBox.Font.Size
  .Object.AutoSize = True
  .Object.IntegralHeight = False
End With

For iCol = LBound(theList, 2) To UBound(theList, 2)
  For lRow = LBound(theList, 1) To UBound(theList, 1)
    objDummy.Object.Text = vbNullString
    On Error Resume Next
    objDummy.Object.Text = CStr(theList(lRow, iCol))
    On Error GoTo 0
    If objDummy.Width > dblMax Then dblMax = objDummy.Width
  Next
  dblWidth = dblWidth + dblMax
  strColWidth = strColWidth & CStr(dblMax) & ";"
  dblMax = 0
Next

With theBox
  .ColumnCount = UBound(theList, 2) + IIf(LBound(theList, 2) = 0, 1, 0)
  .ColumnWidths = Left(strColWidth, Len(strColWidth) - 1)
  .List = theList
  If setBoxWidth Then .Width = dblWidth + 5
End With

On Error Resume Next
objDummy.Delete
Set objDummy = Nothing
End Function

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Beliebteste Forumthreads (12 Monate)

Josef Ehrensberger - Userform noch ein "Problem"

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

87 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Josef Ehrensberger - Userform noch ein "Problem"

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

87 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread