Tipp 0423 ListBox-Spaltenüberschriften mit ColumnHeads
Autor/Einsender:
Datum:
  Angie
19.11.2004
Entwicklungsumgebung:   Excel 2000
In Excel ist es möglich, mit der ColumnHeads-Eigenschaft in Verbindung mit der RowSource-Eigenschaft Spaltenüberschriften in einer ListBox und ComboBox anzuzeigen, wobei in der ComboBox die Überschriften nur dann angezeigt werden, wenn die DropDown-Liste sichtbar ist.
Sollen mehrere nicht zusammenhängende Bereiche in einer ListBox oder ComboBox mit Spaltenüberschriften angezeigt werden, könnte das so wie in diesem Beispiel gelöst werden. Hier werden die anzuzeigenden Bereiche zunächst mit der Union-Methode vereinigt und in ein per Code neu hinzugefügtes Tabellenblatt kopiert, das beim Schließen der UserForm wieder gelöscht wird.
Damit das Prozedere ggf. für mehreren ListBoxen/Tabellenblätter angewendet werden kann, wurde hier ein Collection-Objekt definiert, in dem die zu löschenden Tabellenblätter gespeichert werden.
 
Option Explicit

Private Const mc_OptWdth As Single = 12
Private Const mc_SbrWdth As Single = 15

Private mcol_WksToDelete As Collection

Private Sub UserForm_Initialize()
  Dim rngSrc As Range

  With Me.lstWksData1
    .ColumnHeads = True
    .ListStyle = fmListStyleOption
    .MultiSelect = fmMultiSelectExtended
  End With

  With ThisWorkbook.Worksheets("ListBoxDemo1")
    Set rngSrc = .Range(.Cells(1, 1), .Cells(8, 7))
  End With

  ShowWksData rngSrc, Me.lstWksData1, False
  Set rngSrc = Nothing

  With Me.lstWksData2
    .ColumnHeads = True
  End With

  With ThisWorkbook.Worksheets("ListBoxDemo2")
    Set rngSrc = Union(.Range(.Cells(5, 1), .Cells(5, 4)), _
          .Range(.Cells(35, 1), .Cells(40, 4)))
  End With

  ShowWksData rngSrc, Me.lstWksData2
  Set rngSrc = Nothing
End Sub

Private Sub ShowWksData(ByVal rngSrc As Range, ByVal lstListBox _
    As MSForms.ListBox, Optional fSetColWidths As Boolean = True)

  Dim nColsCnt    As Long
  Dim n           As Long

  Dim lngColWdth  As Long
  Dim strColWdths As String

  nColsCnt = rngSrc.Columns.Count

  If fSetColWidths = True Then
    If lstListBox.ListStyle = fmListStyleOption Then
      lngColWdth = _
           (lstListBox.Width - mc_SbrWdth - mc_OptWdth) \ nColsCnt
    Else
      lngColWdth = (lstListBox.Width - mc_SbrWdth) \ nColsCnt
    End If

    For n = 1 To nColsCnt
      strColWdths = strColWdths & lngColWdth & ";"
    Next
    strColWdths = VBA.Left(strColWdths, Len(strColWdths) - 1)
  End If

  With lstListBox
    .ColumnCount = nColsCnt

    If fSetColWidths = True Then
      .ColumnWidths = strColWdths
    End If

    If rngSrc.Areas.Count > 1 Then
      Dim objSheetA As Object
      Dim wksNew    As Worksheet
      
      Set objSheetA = rngSrc.Parent.Parent.ActiveSheet
      Application.ScreenUpdating = False

      Set wksNew = rngSrc.Parent.Parent.Worksheets.Add
      rngSrc.Copy
      wksNew.Cells(1, 1).PasteSpecial Paste:=xlValues
      Application.CutCopyMode = False

      wksNew.Visible = xlSheetVeryHidden
      Set rngSrc = wksNew.Cells(1, 1).CurrentRegion

      If mcol_WksToDelete Is Nothing Then
        Set mcol_WksToDelete = New Collection
      End If
      mcol_WksToDelete.Add wksNew, wksNew.Name

      objSheetA.Activate
      Set objSheetA = Nothing

      Application.ScreenUpdating = True
    End If

    If (lstListBox.ColumnHeads = True) And _
            (rngSrc.Rows.Count > 1) Then
      .RowSource = rngSrc.Offset(1, 0).Resize( _
            rngSrc.Rows.Count - 1).Address(External:=True)

    Else
      .RowSource = rngSrc.Address(External:=True)
    End If
  End With
End Sub

Private Sub UserForm_Terminate()
  If Not mcol_WksToDelete Is Nothing Then
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim n As Long
    For n = 1 To mcol_WksToDelete.Count
      mcol_WksToDelete(1).Visible = xlSheetVisible
      mcol_WksToDelete(1).Delete
      mcol_WksToDelete.Remove 1
    Next
    Set mcol_WksToDelete = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
  End If
End Sub
 
Weitere Links zum Thema
ListBox - RowSource-Eigenschaft
ListBox - RowSource-/ColumnHeads-Eigenschaft
ListBox - Spaltenüberschriften in 2. ListBox anzeigen (VBA/Word)

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Excel-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (49 kB) Downloads bisher: [ 1559 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 31. Mai 2011