Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Tabellenspalten in UF darstellen
#1
Hallo in Runde,

wie angekündigt hier mein "zweites Problem"....

Ich möchte die Listbox1 einer UF nutzen, um aus den Spalten A bis F nacheinander Werte darzustellen und mit Klick den ausgewählten Wert in eine Zelle zu übertragen.

Neben der Listbox1 sind Felder erstellt, welche diese getätigte Auswahl darstellen soll (der User bekommt das Blatt auf / mit dem er arbeitet nicht zu Gesicht).

Die Listbox1 stellt also zu Beginn die Spalte A dar. Gleichzeitig ist das erste Feld der rechten Seite farbig makiert.
Der User wählt in der Listbox1 einen Wert aus, dieser wird in die entsprechende Zelle im Tabellenblatt eingetragen und die Eintragung wird in der UF auf der rechten Seite dargestellt.

Nun kommts...

Jetzt soll die Listbox1 die Spalte B darstellen und auf der rechten Seite soll die zweite Box farbig markiert werden.
Nun der gleiche Ablauf.
Der User klickt in die Listbox1, der Wert geht auf dem Tabellenblatt in die entspr. Zelle und die zweite Box der rechten Seite stellt den Wert dar.
Allsdann zeigt die Listbox die Spalte C an...
usw...

Der Clearbutton löscht die entsprechende Zelle auf dem Tabellenblatt, damit erlischt die Anzeige in der rechten Box. 
Die Listbox1 soll die nun diesem Feld zugehörige Spalte des Tabellenblattes darstellen, gleichzeitig soll die rechte Box wieder ihre farbige Markierung erhalten.
Nun kann der User die Eingabe für diese Zelle erneut vornehmen.

An was scheitere ich?
wahrscheinlich ist das ganze totaler Blödsinn was ich da gebaut hab...  :16:

1.) In meiner Beispieldatei wird die komplette Range der entsprechenden Spalte angezeigt. Die Variante 
Code:
"Tabelle3!A2:A" & loletzte

wirft "Variable nicht definiert" aus.

2.) ich hab nicht raus wie ich das gestalten kann, dass nicht alle Felder auf einmal farbig angzeigt werden, sondern immer nur der, den die Listbox1 gerade anzeigt.
Irgendwo muss ich der UF doch sagen, dass sie nach erfolgtem Wechsel der Listbox1 Anzeige, die Farbe der rechten Box wieder zurück stellen muss...

3.) die Listbox wechselt nicht (nach klick darin und Übernahme des Wertes in die Zelle) auf die nachfolgende Spalte des Tabellenblattes.

4.) der Clearbutton wechselt zwar die Anzeige der Listbox1 korrekt - aber auch hier das Problem das die farbige Markierung nicht wechselt

Ich habe eine Beispielmappe gebaut und unten angehangen.
Vielleicht könnte mir hier mal jemand über die Schulter schauen/unter die Arme greifen?


Liebe Grüße
Klaus


Angehängte Dateien
.xlsm   Tabellen Spalten in UF darstellen.xlsm (Größe: 29,05 KB / Downloads: 11)
Antworten Top
#2
Hallo Klaus,

ohne das Ganze zu verstehen bzw. verstehen zu wollen, zu deinem 1.) sagt dir doch Excel was fehlt: "Variable nicht definiert"!
Du willst die Variable loLetzte verwenden ohne sie überhaupt deklariert zu haben bzw. ihr einen Wert zugewiesen zu haben.
Da gehört hin:
Dim loLetzte As Long - das ist die Deklarierung
loLetzte = 100 oder loLetzte = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row - für die Ermittlung der letzten belegten Zeile in Spalte A (1) - Bezüge an die realen Gegebenheiten anpassen!


WICHTIGER HINWEIS: Variablen in einem Makro sollten IMMER deklariert werden!
[Bild: attachment-190.gif]
Gruß Günter
aus der Helden-, Messe-, Musik-, Buch-, Universitäts- und Autostadt Leipzig
Antworten Top
#3
Guten Abend in die Runde.

Glausius, Dir besten Dank für den Tip. Jetzt hab ichs...  :19:



Nr.: 1) ist damit erledigt - das klappt jetzt wunderbar.

Nr.: 2) hat sich (wahrscheinlich) auch erledigt - den Befehl das sich die Farbe der Box zurück auf Normal stellen soll, habe ich hinter den Klick in die Listbox1 gelegt. Wie sollte das sonst wohl gehen?

AAABER Nr.: 3)

Bei Nr.: 3) bin ich nun mittlerweile soweit, dass das ich meine zu erkennen, dass die Listbox ihre Range nicht ändern kann, solange sich der Code des Klicks im Ablauf befindet.
Will sagen - man müsste das Ding wohl erst deaktivieren, die Range ändern und dann wieder aktivieren...
Weise ich der Listbox nach Klick und Datenübernahme ins Tabellenblatt den Rangewechsel über einen Button zu, dann klappt das... Aber genau das will ich ja eigentlich nicht.
*grummel* 
Listbox sollte doch nach jeder Datenübernahme von selbst die Range wechseln...

Könnte man das nicht irgendwie umgehen? 

Liebe Grüße
Klaus
Antworten Top
#4
Hallo Klaus,

ich habe da mal etwas vorbereitet....

Also Das Klick Ereignis ist für Dein Vorhabe leider nicht nutzbar.
Ich musste auf das Doppelklick zurückgreifen. Also in die Listbox einen Doppelklick machen.

Mit einfachem Klick funktioniert die neu Befüllung nicht. Im Hintergrund scheint sie neu befüllt zu sei, aber man hat keine Einträge in der Listbox.
Dass sie im Hintergrund befüllt ist, konnte man durch gezielte Abfrage auf ListCount feststellen.

Aber Doppelklick ist auch nicht übel.
Bitte im Codefenster der Userform allen Code löschen und folgenden hinein kopieren:

Code:
Option Explicit

Private Sub CommandButton1_Click()
 löschen
End Sub

Private Sub CommandButton2_Click()
 löschen
End Sub

Private Sub CommandButton3_Click()
 löschen
End Sub

Private Sub CommandButton4_Click()
 löschen
End Sub

Private Sub CommandButton5_Click()
 löschen
End Sub

Private Sub CommandButton6_Click()
 löschen
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 Dim i As Long
 Dim lngZ As Long

 lngZ = 7
 Do
   i = i + 1
 Loop Until Cells(i, 9) = "" Or i > lngZ
 If i > 7 Then
   Me.ListBox1.Clear
 ElseIf i <= 6 Then
   Cells(i, 9) = Me.ListBox1
   Me.Frame1.Caption = Cells(1, i).Value
   If Application.CountA(Range("I2:I7")) < 6 Then
     lngZ = Cells(Rows.Count, i).End(xlUp).Row
     Me.Controls("Listbox" & i).BackColor = &H8000000F
     Me.Controls("Listbox" & i + 1).SetFocus
     listbox_füllen
   Else
     Cells(i, 9) = Me.ListBox1
     Me.Frame1.Caption = Cells(1, i).Value
     Me.Controls("Listbox" & i).ListIndex = 0
     Me.Controls("Listbox" & i).BackColor = &H8000000F
     Me.Controls("Listbox" & i).SetFocus
     listbox_füllen
'      Me.ListBox1.Clear
   End If
 Else
   Cells(i, 9) = Me.ListBox1
   Me.Frame1.Caption = Cells(1, i).Value
   Me.Controls("Listbox" & i).ListIndex = 0
   Me.Controls("Listbox" & i).BackColor = &H8000000F
   Me.Controls("Listbox" & i + 1).SetFocus
   listbox_füllen
'    Me.ListBox1.Clear
 End If
 Me.Tag = 0
End Sub

Private Sub UserForm_Initialize()
Dim i As Long
 Dim lngZ As Long, lngS As Long
 Range("I2:I7").ClearContents
 
 lngZ = Cells(Rows.Count, 1).End(xlUp).Row
 lngS = Cells(Rows.Count, 8).End(xlUp).Row
 
 If lngS < 2 Then
   MsgBox "Keine Auswahl eingetragen!"
   Exit Sub
 End If
 
 Me.ListBox1.Tag = 2
 
 Frame2.Caption = Range("H2")
 Frame3.Caption = Range("H3")
 Frame4.Caption = Range("H4")
 Frame5.Caption = Range("H5")
 Frame6.Caption = Range("H6")
 Frame7.Caption = Range("H7")

 With ListBox1
   ListBox1.List = Range(Cells(2, 1), Cells(lngZ, 1)).Value 'Bereich1
   Frame1.Caption = Range("A1")
 End With
 
 For i = 1 To 6
   Me.Controls("CommandButton" & i).Tag = i
 Next i
 Me.Tag = 1
End Sub


Sub löschen()
 Dim i As Long, j As Long
 Dim lngZ As Long
 lngZ = 7
 j = ActiveControl.Tag
 Do
   i = i + 1
 Loop Until Cells(i, 9) = "" Or i > lngZ
 If Me.Tag = 0 And j < i Then
   lngZ = Cells(Rows.Count, j).End(xlUp).Row
   Cells(j + 1, 9) = ""
   
   With ListBox1
     .List = Range(Cells(2, j), Cells(lngZ, j)).Value 'Bereich
     Me.Controls("Listbox" & j + 1).ListIndex = -1
   End With
   Me.Controls("Listbox" & j + 1).BackColor = RGB(500, 0, 0)
   For i = 2 To 7
     Me.Controls("Listbox" & i).ListIndex = -1
   Next i
   Me.Tag = 1
 End If
End Sub

Sub listbox_füllen()
 Dim i As Long, j As Long
 Dim lngZ As Long
 lngZ = 7
 Do
   j = j + 1
 Loop Until Cells(j, 9) = "" Or j > lngZ
 If j < 8 Then
   lngZ = Cells(Rows.Count, j - 1).End(xlUp).Row
   Me.ListBox1.List = Range(Cells(2, j - 1), Cells(lngZ, j - 1)).Value
   Me.Controls("Listbox" & j).SetFocus
   Me.Controls("Listbox" & j).ListIndex = 0
   Me.Controls("Listbox" & j + 1).BackColor = &H8000000F
 Else
   Me.ListBox1.Clear
 End If
End Sub


Ich denke, dass ich Deinen Wunsch umgestzt habe. Jedoch befürchte ich, dass es nicht das ist, was Du Dir vorstellst.

Der Bereich H2:I7 ist statisch und muss im Code an verschiedenen Stellen angepasst werden, wenn mehr Zeilen hinzukommen.
Ansonsten wäre ein sauberer Ablauf mit den Löschoptionen und Neuschreiben sehr kompliziert geworden.

EDIT:
Ach noch etwas, achte beim Testen darauf, dass unter den Spalten H und I sowie unter A:F keine anderen Daten stehen.
Gruß Atilla
Antworten Top
#5
Hallo Atilla,

das ist doch wunderbar mit Doppelklick. Ich bin begeistert. Ich glaub das ist nur eine kurze Gewöhnungsphase, dann hat man das drin Smile

Könnte man das noch einstellen, dass die Markierung des Wertes in der Listbox1 beim Wechsel auf die nächste Range, nicht vom Vorgänger übernommen wird?
Dass das Feld also Weiß ist wenn die neue Range dargestellt wird?

Super, ich freu mich total Smile

Liebe Grüße
Klaus
Antworten Top
#6
Hall Klaus,

ich glaube, ich brauche immer mehrere Anläufe um Dich zu verstehen, heißt ich habe Dich jetzt nicht wirklich verstanden.

Aber ich habe selber einige Ungereimtheiten bei der Beschriftung der Frames festgestellt, deshalb hier der gesamte Code mit Korrekturen.
Vielleicht ist es damit getan, was Du beschreibst.


Code:
Private Sub CommandButton1_Click()
 löschen
End Sub

Private Sub CommandButton2_Click()
 löschen
End Sub
Private Sub CommandButton3_Click()
 löschen
End Sub

Private Sub CommandButton4_Click()
 löschen
End Sub
Private Sub CommandButton5_Click()
 löschen
End Sub

Private Sub CommandButton6_Click()
 löschen
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 Dim i As Long
 Dim lngZ As Long
 If ListBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
 lngZ = 7
 Do
   i = i + 1
 Loop Until Cells(i, 9) = "" Or i > lngZ
 If i > 7 Then
   Me.ListBox1.Clear
 ElseIf i <= 6 Then
   Cells(i, 9) = Me.ListBox1
   
   If Application.CountA(Range("I2:I7")) < 6 Then
'      Me.Frame1.Caption = Cells(1, i).Value
     lngZ = Cells(Rows.Count, i).End(xlUp).Row
     Me.Controls("Listbox" & i).BackColor = &H8000000F
     Me.Controls("Listbox" & i + 1).SetFocus
     listbox_füllen
   Else
     Cells(i, 9) = Me.ListBox1
'      Me.Frame1.Caption = Cells(1, i).Value
     Me.Controls("Listbox" & i).ListIndex = 0
     Me.Controls("Listbox" & i).BackColor = &H8000000F
     Me.Controls("Listbox" & i).SetFocus
     listbox_füllen
'      Me.ListBox1.Clear
   End If
 Else
   Cells(i, 9) = Me.ListBox1
   Me.Controls("Listbox" & i).ListIndex = 0
   Me.Controls("Listbox" & i).BackColor = &H8000000F
   Me.Controls("Listbox" & i + 1).SetFocus
   listbox_füllen
'    Me.ListBox1.Clear
 End If
 Me.Tag = 0
End Sub

Private Sub UserForm_Initialize()
Dim i As Long
 Dim lngZ As Long, lngS As Long
 Range("I2:I7").ClearContents
 
 lngZ = Cells(Rows.Count, 1).End(xlUp).Row
 lngS = Cells(Rows.Count, 8).End(xlUp).Row
 
 If lngS < 2 Then
   MsgBox "Keine Auswahl eingetragen!"
   Exit Sub
 End If
 
 Me.ListBox1.Tag = 2
 
 Frame2.Caption = Range("H2")
 Frame3.Caption = Range("H3")
 Frame4.Caption = Range("H4")
 Frame5.Caption = Range("H5")
 Frame6.Caption = Range("H6")
 Frame7.Caption = Range("H7")

 With ListBox1
   ListBox1.List = Range(Cells(2, 1), Cells(lngZ, 1)).Value 'Bereich1
   Frame1.Caption = Range("A1")
 End With
 
 For i = 1 To 6
   Me.Controls("CommandButton" & i).Tag = i
 Next i
 Me.Tag = 1
End Sub


Sub löschen()
 Dim i As Long, j As Long
 Dim lngZ As Long
 lngZ = 7
 j = ActiveControl.Tag
 Do
   i = i + 1
 Loop Until Cells(i, 9) = "" Or i > lngZ
 If Me.Tag = 0 And j < i Then
   lngZ = Cells(Rows.Count, j).End(xlUp).Row
   Cells(j + 1, 9) = ""
   
   With ListBox1
     .List = Range(Cells(2, j), Cells(lngZ, j)).Value 'Bereich
     Me.Controls("Listbox" & j + 1).ListIndex = -1
   End With
   Me.Controls("Frame" & 1).Caption = Cells(j + 1, 8).Value
   Me.Controls("Listbox" & j + 1).BackColor = RGB(500, 0, 0)
   For i = 2 To 7
     Me.Controls("Listbox" & i).ListIndex = -1
   Next i
   Me.Tag = 1
 End If
End Sub

Sub listbox_füllen()
 Dim i As Long, j As Long
 Dim lngZ As Long
 lngZ = 7
 Do
   j = j + 1
 Loop Until Cells(j, 9) = "" Or j > lngZ
 If j < 8 Then
   lngZ = Cells(Rows.Count, j - 1).End(xlUp).Row
   Me.ListBox1.List = Range(Cells(2, j - 1), Cells(lngZ, j - 1)).Value
   Me.Frame1.Caption = Cells(j, 8)
   Me.Controls("Listbox" & j).SetFocus
   Me.Controls("Listbox" & j).ListIndex = 0
   Me.Controls("Listbox" & j + 1).BackColor = &H8000000F
 Else
   Me.Frame1.Caption = ""
   Me.ListBox1.Clear
 End If
End Sub




Nun lieber Klaus, habe ich aber eine schlechte Nachricht für Dich!!!!
Nein..., keine Angst, nicht die Rechnung.

Sondern, ich schaffe es mit dem Aufbau und dem eingestellten Code immer wieder Excel zum Absturz zu bringen.
Ich gehe mal davon aus, dass Du es auch irgendwann schaffen wirst.:19: 

Woran das liegt, konnte ich feststellen nur das warum ist für mich nicht ganz klar.
Es passiert, wenn Du innerhalb der Listbox1 immer auf den letzten Eintrag einen Doppelklick ausführst.
Bitte mal testen. Hintereinander immer auf den letzten Eintrag doppelklicken.

Dann verabschiedet sich Excel, entweder schon beim ersten oder auch irgendwann bei einem anderen Doppelklick, mit der Fehlermeldung "Excel funktioniert nicht mehr".
Im Hintergrund ist der Debugger noch kurz zu sehen, mit der Meldung: "Automatisierungsfehler: Das aufgerufene Objekt wurde vom Client getrennt."

Ich vermute, dass das Doppelklick so schnell regiert, dass vor dem neu Befüllen der Liste ein Doppelklick noch irgendwohin ausgeführt wird.

Im Code habe On Error Resume genutzt, aber keine Verbesserung erfahren.

Nun, was machen, mit dem Fehler leben, umgehen mit einem Dummyeintrag am Ende jeder Liste, den letzten Eintrag nie Wählen oder hoffen,
dass einer der VBA Experten hier eine Lösung kennt und auch mitteilt.

So das war mein Drama für Dich. Warten wir auf die Resonanz.
Gruß Atilla
Antworten Top
#7
Oh Atilla, das tut mir leid wenn ich so schwer verständlich geworden bin.
Ich geb mir Mühe das besser zu machen. 


Nun versuche ich erstmal, bevor ich auf Deinen Text eingehe, deutlich zu machen was ich rüber bringen wollte.
Ich nummeriere das am besten mal damit das was jetzt noch kommt übersichtlich bleibt Smile

1.) Was wollte ich sagen?
Wenn die UF aufgeht, dann ist die Listbox1 mit dem Inhalt der Spalte A gefüllt. Nichts ist markiert.
Um Daten übernehmen zu können doppelklickt unser User in die Listbox1. 
Es entsteht eine Markierung der gewünschten Zeile in der Listbox1 und der Wert wird in das Tabellenblatt geschrieben.
Gleichzeitig wechselt die Listbox1 nun die Ansicht und zeigt die Spalte B an. Wunderbar dass das alles so klappt Smile Gefällt mir gut Smile
Und hier kommt das was ich meine:
Während dieser neuen Anzeige verbleibt aber die Markierung die gerade eben getätig wurde. 
Obwohl noch nichts angeklickt wurde in der Anzeige der Spalte B ist dort nun schon eine Zeile in der Listbox1 markiert.
Das wollte ich gern rausnehmen. Sodass ein schönes weißes Feld erscheint. 
Wenn ich wüsste wohin damit würde ich ja mit Listindex=-1 rumhantieren. Aber dazu komme ich gleich Wink

2.) Ich hatte ein zu große Klappe Wink
Als ich in einem anderen Thema schrieb, dass ich Deine Codes (bis zu einem gewissen Teil) lesen kann, war ich sehr voreilig.
Diesen hier kann ich genauso gut wie die von snb lesen...

Ich wollte nämlich etwas anpassen.
Nachdem ich heute das von Dir erwähnte Phänomen in der Originaldatei auf Arbeit getestet habe, musste ich feststellen, dass ich in der Beispieldatei eine Spalte und damit auch eine Box sowie dann auch einen Button zu viel eingebaut habe.
Leider kann ich beim besten Willen nicht deuten an welcher Stelle ich nun den Code korrigieren müsste um den Ablauf wieder rund zu bekommen.

3.) Feinheiten
Noch eine Kleinigkeit wollte ich anpassen.
Wenn die UF geöffnet wird, dann wird die Listbox1 sofort mit dem Inhalt der Spalte A gefüllt. Das ist gut so, genauso soll es auch sein.
Die zugehörige Box der rechten Seite bleibt unmarkiert.
Wechselt nun die Listbox1 nach Doppelklick die Anzeige auf Spalte B, wird die zugehörige rechte Box blau markiert.
Genau diesen Effekt wollte ich für die Spalte A auch einstellen. (Also die Markierung der entsprechenden rechten Box zum Start der UF hinzufügen)
Aber - Du ahnst es - ich bin dermaßen blind - ich finde keine einzige Stelle im Code die eine andere Farbe als das originiale Grau oder das Rot nach klick auf einen Button anspricht.
Ich vermute es ist kein Blau? Es ist sowas wie "Markiert"? Aber selbst diesen Punkt im Code kann ich nicht deuten...

4.) Excelabsturz
Wie schon erwähnt habe ich heut gleich mal auf Arbeit die Wiederstandsfähigkeit des dortigen PC getestet.
Ich habe die Beispieldatei sowie das Original entspechend Deiner Anleitung mehrfach durchgeklickt - ich kann keinen Absturz oder sonstige Fehlermeldung feststellen.
Auch mein PC zu Haus hält sich wacker. Keine Probleme erkennbar.
Sollte sich das aber auch bei mir noch zeigen würde ich, sofern kein anderer Plan auftaucht, tatsächlich diese Dummyvariante verwenden und einen Leereintrag ans Ende setzen.

Übrigens dachte ich nach Deiner Ankündigung Du verlässt das Forum oder ich hab zu sehr genervt oder was doofes gesagt oder Deine Tastatur stirbt...
*schweißabwisch*
Wink

Liebe Grüße
Klaus
Antworten Top
#8
Hallo Klaus,

zu 1.
Das gefiel mir auch nicht, aber konnte es auch nicht abstellen.
Ich wollte abwarten, wie es bei Dir aussieht. Manchmal hängt das auch von den genutzten Mäusen ab.
Man schafft scheinbar kein Doppelklick, meist wird daraus ein Trippelklick, und dieser dritte Klick markiert wieder.

Nun habe ich ein Workaround genutzt, mit dem es relativ gut funktioniert.
Dazu bitte das ListBox1_DblClick Ereignis suchen und am Ende vor End Sub diese Zeilen einfügen:


Code:
 DoEvents
 If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1
 Application.Wait (Time + TimeValue("00:00:01"))
 If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1

Ist doppelt gemoppelt aber funktioniert damit am besten.


zu 2.
Ich habe ja gesagt, dass der Code starr ist. Also immer die Spalten A-F und den Bereich H1:I7 im Code verarbeitet werden. Wenn neue Spalten dazu kommen,
dann such mal nach der Zahl 7 im Code. Die steht für Spalte 6 bzw. bis zu Listbox7
Die Schaltflächen, 6 an der Zahl, werden in diesen Zeilen angesprochen:


Code:
 For i = 1 To 6
   Me.Controls("CommandButton" & i).Tag = i
 Next i

Die Frames hattest Du ja schon so drin, musst Du halt ergänzen.
Dann Jeder Schaltfläche das Clik Ereignis zuweisen.


zu 3.

Such die Prozedur UserForm_Initialize() und ergänze folgende Zeile vor End SUb:
Code:
Me.ListBox2.ListIndex = 0

Zitat:Ich vermute es ist kein Blau? Es ist sowas wie "Markiert"? Aber selbst diesen Punkt im Code kann ich nicht deuten...
Ja, es ist eine Auswahlmarkierung, genauso, wie wenn Du in die Listbox klickst. Kannst Du ja testen, indem Du einfach in eine der Boxen klickst, es wird blau, von Excel so vorgegeben. Ich erreiche das im Code damit, dass ich den Boxen die Listindex = 0 zuweise. Das entspricht der Auswahl des ereten Eintrags der Lisbox.
Also such mal nach (...).Index = 0 im Code.


zu 4.
Da haben wir ja wieder mal Glück gehabt! (Schmidteinander)
Gruß Atilla
Antworten Top
#9
Hallo Klaus,

hab mal den Code ein wenig kommentiert.
Das war keine schlechte Idee, dabei fallen einem Ungereimtheiten im Code besser auf, muss ich öfter machen.
Den Code habe ich bei der Gelegenheit auch etwas aufgeräumt und gestaucht.

Schau mal ob Du mit den Kommentaren klar kommst.


Code:
Option Explicit

Private Sub CommandButton1_Click()
 löschen
End Sub

Private Sub CommandButton2_Click()
 löschen
End Sub
Private Sub CommandButton3_Click()
 löschen
End Sub

Private Sub CommandButton4_Click()
 löschen
End Sub
Private Sub CommandButton5_Click()
 löschen
End Sub

Private Sub CommandButton6_Click()
 löschen
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 If ListBox1.ListCount Then   'wenn Anzahl Einträge in listbox1 dann
   listbox_füllen
'    DoEvents         'Übergibt die Steuerung an das Betriebssystem, damit es andere Ereignisse verarbeiten kann
   If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1    'wenn einträge in der listbox dann Listindex auf -1 -> damit keine Auswahl
   Application.Wait (Time + TimeValue("00:00:01"))             'Codeausführung für 1 sec anhalten
   If Me.ListBox1.ListCount Then Me.ListBox1.ListIndex = -1
 End If
End Sub

Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'bei Doppelklick auf die Userform
 UserForm_Initialize 'Userform wird neu geladen; alles was beim ersten Laden passierte, wird erneut ausggeführt.
End Sub

Private Sub UserForm_Initialize()
 Dim i As Long
 Dim lngZ As Long, lngS As Long

 lngZ = Cells(Rows.Count, 1).End(xlUp).Row 'letzte belegte Zelle Spalte A
 lngS = Cells(Rows.Count, 8).End(xlUp).Row 'letzte belegte Zelle Spalte H
 
 Range("I2:I" & Cells(Rows.Count, 9).End(xlUp).Row + 1).ClearContents 'I2 bis letzte belegte Zelle inhalte löschen
 
 If lngS < 2 Then                      'wenn Spalte H weniger als zwei Einträge
   MsgBox "Keine Auswahl eingetragen!"
   Exit Sub
 End If

 ListBox1.List = Range(Cells(2, 1), Cells(lngZ, 1)).Value 'Listbox1 aus Spalte A füllen
 Frame1.Caption = Range("A1")    'Frame1 beschriften mit Überschrift aus Spalte A
 
 For i = 2 To lngS   'Frames 2 bis soviele Einträge wie in Spalte H mit den Werten aus Spalte H beschriften
   Me.Controls("Frame" & i).Caption = Cells(i, 8)
 Next i
 
 For i = 1 To lngS - 1    'In die Tag Eigenschaft der Schaltfläöschen den Wert von i reinschreiben
   Me.Controls("CommandButton" & i).Tag = i
 Next i
 Me.ListBox1.Tag = ""
End Sub


Sub löschen()     'wird bei Clear Schatflächen ausgeführt
 Dim i As Long, j As Long
 Dim lngZ As Long, lngS As Long
 lngZ = Cells(Rows.Count, 9).End(xlUp).Row 'Letzte belegte Zelle in Spalte 9
 j = ActiveControl.Tag   'der Wert in der Tag Eigennschaft der aufrufenden Schaltfläsche wird an Variable j übergeben
 ListBox1.Tag = j        'Der glkeiche Wert wird in die Tag Eigenschaft der Listbox1 geschrieben
 If j < lngZ Then    'Wenn Userfoerm Tag = 0 und j (Schlatflächenindex) < letzte belegte Zeile in Spalte I
   lngS = Cells(Rows.Count, j).End(xlUp).Row   'Letzte belegte Zelle in Spalte j=Schaltfläschenindex
   Cells(j + 1, 9) = ""                        'Zelleninhalt leeren
   ListBox1.List = Range(Cells(2, j), Cells(lngS, j)).Value 'Bereich aus Spalte j=Schaltfläschenindex und letzten Zelle aus Spalte j=Schaltfläschenindex in listbox1 einlesen
   Me.Frame1.Caption = Cells(j + 1, 8).Value     'Frame1 neu beschriften mit der Überschrift der eingelesenen Spalte
   Me.Controls("Listbox" & j + 1).BackColor = RGB(500, 0, 0) 'Listbox mit dem Index der aufrufenden Schaltfläche +1 roter Hintergrund
   Me.Controls("Listbox" & lngZ + 1).ListIndex = -1    'Listindex der vorher ausgewählten Listbox auf -1 setzen um die markierung wegzunehmen
 End If
End Sub

Sub listbox_füllen()
 Dim i As Long, j As Long, lngAnzahl As Long
 Dim lngZ As Long, lngZ2 As Long, lngS As Long
 lngZ = Cells(Rows.Count, 9).End(xlUp).Row + 1 'erste freie zelle in Spalte I
 lngAnzahl = Application.CountA(Columns("I"))
 If lngAnzahl < lngZ - 1 Then   'wenn Anzahl der Einträge kleiner ist als die Zeilenzahl letzen belegten Zelle in spalte I dann (bedeutet es wurde eine Schaltfläsche zum Löschen betätigt, sodass zwischendurch etwas gelöscht worden sein kann; siehe löschen Routine)
   lngZ2 = Me.ListBox1.Tag + 1  'Dann wird die Variable lngZ2 mit dem Index aus Tag Eigenschaft belegt (das ist die Spalte aus der die Listbox gefüllt werden muss und die Zeile in die in Spalte I geschrieben werden muss
   Cells(lngZ2, 9) = Me.ListBox1   'in Zile lngZ2 = Schaltfläschenindex (in Tag Eigenschaft der listbox zu finden) der Spalte 9 den Listbox1 Eintrag schreiben
   Me.Controls("Listbox" & lngZ).ListIndex = -1
   lngS = Cells(Rows.Count, lngZ2).End(xlUp).Row 'aus der Spalte
   Me.ListBox1.List = Range(Cells(2, lngZ - 1), Cells(lngS, lngZ - 1)).Value
   Me.Frame1.Caption = Cells(lngZ, 8)
   Me.Controls("Listbox" & lngZ).SetFocus
   Me.Controls("Listbox" & lngZ).ListIndex = 0
   Me.Controls("Listbox" & lngZ2).BackColor = &H8000000F
   Me.ListBox1.Tag = ""
 Else   'SONST; Tag Eigenschaft leer bedeutet keine Schaltfläche vorher getätigt, immer die erste frei Listbox und die folgende wird bearbeitet
   If lngZ < Cells(Rows.Count, 8).End(xlUp).Row Then
     Cells(lngZ, 9) = Me.ListBox1
     Me.Controls("Listbox" & lngZ).ListIndex = -1
     lngS = Cells(Rows.Count, lngZ).End(xlUp).Row
     Me.ListBox1.List = Range(Cells(2, lngZ), Cells(lngS, lngZ)).Value
     Me.Frame1.Caption = Cells(lngZ, 8)
     Me.Controls("Listbox" & lngZ + 1).SetFocus
     Me.Controls("Listbox" & lngZ + 1).ListIndex = 0
     Me.Controls("Listbox" & lngZ).BackColor = &H8000000F
   Else
     Cells(lngZ, 9) = Me.ListBox1
     Me.Controls("Listbox" & lngZ).ListIndex = -1
     Me.Controls("Listbox" & lngZ).BackColor = &H8000000F
     Me.Frame1.Caption = ""
     Me.ListBox1.Clear
   End If
 End If
End Sub
Gruß Atilla
Antworten Top
#10
Guten Morgen Atilla,

... was soll ich sagen... 
ich bin jetzt etwas verwirrt...

Ich hab mich grad durch die Anleitung von gestern durchgekämpft - mit einem Hauch von "ahhhhh so ist das gemacht" im Kopf...

Nun sitz ich hier vor der neuen Variante von heute.
Hier nun ein noch dickeres "ahhhhh so ist das gemacht" im Kopf - aber das passt jetzt nicht mehr zu der Anleitung von gestern. 
Wie ich dem Code jetzt sagen kann, dass ich eine Spalte weniger habe - ich sollte die 7 suchen - ist nun entfleucht... Wink Keine 7 mehr drin im Code...

Auch das Zählen der Anzahl der Schaltflächen ist nun anders gelöst...

Code:
For i = 1 To 6
ist jetzt ersetzt durch 
Code:
For i = 1 To lngS - 1
wenn ich dann aber nach lngS suche finde ich das:
Code:
lngS = Cells(Rows.Count, 8).End(xlUp).Row 'letzte belegte Zelle Spalte H
Hier steht aber kommentiert, dass es sich um die Spalte H handelt. Und das ist jene wo die Werte eingetragen werden. Hat glaub ich nichts mit den Button zu tun? Ich hab mich wohl dann doch etwas verirrt im Code..

Einzig die Markierung der Listbox2 also .Index=0 konnte ich wieder finden Smile
Das klappt jetzt super.

Das mit der Codebremse für 1sec funktioniert auch bestens.

Ich bin jetzt also deutlich schlauer als gestern was das Verstehen des - wann passiert was wann - (ein paar Sachen muss ich mir aber noch ergooglen) - aber... ich glaub ich bräuchte nochmal einen Hinweis bezüglich wie ich vorgehen kann wenn ich weniger Spalten und weniger Button + Frames verwenden will... 
 
Liebe Grüße
Klaus
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste