AW: listobject - DataBodyRange Problem
25.04.2019 20:12:39
Georg
Danke für die Mühe.
@Luschi
Bei deinem Vorschlag werden ja die aktuell sichtbaren Zeilen aus der Tabelle kopiert und wo anders wieder eingefügt. Dies ist leider nicht ganz das was ich gesucht habe.
Die Funktionsweise meiner Sub:
Ich erstelle aktuell anhand der Anzahl (im Moment ja alle) von Zeilen im Listobject("Mitgliederliste") jeweils eine Textbox. In diese Textbox wird dann der Text von bestimmten Spalten geschrieben.
Diese Schleife läuft so lange bis das Ende der Objectlist erreicht wurde.
Nun möchte ich aber auch einen Filter setzen und dann natürlich nur noch die Anzahl an Textboxen erstellen, die der sichtbaren Einträge entspricht.
Sub status_pruefen(Optional Kurs As String = "alle")
'Variablen setzen
Dim plTop As Integer, plHeight As Integer, plWidth As Integer, plLeft As Integer
Dim ufHeigth As Integer, ufWidth As Integer
Dim hSpace As Integer, vSpace As Integer
Dim i As Integer, n As Integer
Dim MyCtrl As Control
Dim txtBox1 As Integer, txtBox2 As Integer
Dim varSpalte As Integer
Dim varZeile As Integer
Dim varName As Integer
Dim varVorname As Integer
Dim varKundennummer As Integer
Dim varOrt As Integer
Dim varKurs As Integer
'Userform erstellen
vSpace = 5
hSpace = 5
plTop = 5
plWidth = 50
plHeight = 20
plLeft = 10
'Kurs = "Tango"
Set wb = ThisWorkbook 'Variable/Abkürzung für diese Excel Datei
'Hier wird das worksheet festgelegt. Die Variable "Hersteller" wird in dem Hauptprogramm _
vergeben.
Set ws = Worksheets("Mitglieder")
With wb
'Suchen in dem Sheet (ausgewählter Hersteller) in einer bestimmten Tabelle
Set tbl = ws.ListObjects("Mitgliederliste")
' Die Spalte "Status" wird gesucht
varSpalte = Application.Match("Status", tbl.HeaderRowRange, 0)
'Finden der Spalte "Name"
varName = Application.Match("Name", tbl.HeaderRowRange, 0)
'Finden der Spalte "Vorname"
varVorname = Application.Match("Vorname", tbl.HeaderRowRange, 0)
'Finden der Spalte "Kundennummer"
varKundennummer = Application.Match("Kundennummer", tbl.HeaderRowRange, 0)
'Finden der Spalte "Wohnort"
varOrt = Application.Match("Ort", tbl.HeaderRowRange, 0)
'Finden der Spalte "Kurs"
varKurs = Application.Match("Kurs", tbl.HeaderRowRange, 0)
' Der Anfang wird ab zeile 1 gesetzt
varZeile = 0
'Anzahl der vorhandenen Mitglieder ermitteln
txtBox1 = Mitglieder(Kurs)
'Nur eine Reihe von Textboxen erzeugen.
txtBox2 = txtBox1
ufHeigth = 400
ufWidth = 300
'Die Größe vom neuen Userform wird festgelegt
Debug.Print "Höhe: " & ufHeigth
Status.Height = ufHeigth
Status.Width = ufWidth
For i = 1 To (txtBox1 / txtBox2)
For n = 1 To txtBox2
' Erstellen von Togglebuttons, um den Status der Benutzer dar zu stellen
' Rot = offline
' Grün = online
' Set MyCtrl = Status.Controls.Add("Forms.textbox.1")
'Erstellen vom Tooglebutton
Set MyCtrl = Status.Controls.Add("Forms.ToggleButton.1")
MyCtrl.Left = plLeft
MyCtrl.Top = plTop
MyCtrl.Width = 20 'plWidth / 3
MyCtrl.Height = plHeight
MyCtrl.Name = "ToggleButton" & i
'Einfärben der Buttons um den Status visuell sichtbar zu machen
If tbl.DataBodyRange(varZeile + n, varSpalte) = "T" Then 'Wenn das Mitglied offline ist: _
With MyCtrl
.BackColor = RGB(255, 0, 0) 'rot
.Value = True
' .BackColor = RGB(25, 210, 75) 'grün
.Caption = ""
.TextAlign = fmTextAlignCenter
.Font.Size = 20
.BackStyle = fmBackStyleOpaque
.Locked = True
End With
ElseIf tbl.DataBodyRange(varZeile + n, varSpalte) = "R" Then 'Wenn das Mitglied offline _
ist:
With MyCtrl
.Value = False
' .BackColor = RGB(255, 0, 0) 'rot
.BackColor = RGB(25, 210, 75) 'grün
.Caption = ""
.TextAlign = fmTextAlignCenter
.Font.Size = 20
.BackStyle = fmBackStyleOpaque
.Locked = True
End With
End If
'Erstellen von einer Textbox
Set MyCtrl = Status.Controls.Add("Forms.Textbox.1")
MyCtrl.Left = plLeft + 30
MyCtrl.Top = plTop
MyCtrl.Width = plWidth * 4.5
MyCtrl.Height = plHeight
MyCtrl.Name = "Textbox" & i
plTop = plTop + plHeight + 5
Dim objCell As Range
For Each objCell In tbl.DataBodyRange.SpecialCells(Type:=xlCellTypeVisible)
' Call MsgBox(objCell.Value)
Next
Name = tbl.DataBodyRange(varZeile + n, varName)
Vorname = tbl.DataBodyRange(varZeile + n, varVorname)
Ort = tbl.DataBodyRange(varZeile + n, varOrt)
kundennummer = tbl.DataBodyRange(varZeile + n, varKundennummer)
MyCtrl.Value = Name & " " & Vorname & ", " & Ort & ", " & kundennummer
Next n
plTop = 5
plLeft = plLeft + plWidth + hSpace
Next i
Status.ScrollHeight = MyCtrl.Top
End With
End Sub
Möglicherweise wird mein Problem so besser sichtbar.
Ich danke für jeden Rat!
Liebe Grüße