Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
444to448
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
444to448
444to448
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Probleme mit Listbox

Probleme mit Listbox
25.06.2004 10:54:57
Steffen
Hallo,
ich hatte ein ähnliches Thema weiter unten schon einmal gestellt. Ich bin nun selbst ein wenig weiter gekommen, aber nun stecke ich fest.
Mein Problem beginnt bei 'With .lstListBox'. 'lstLIstbox' ist der Name der Listbox in der UserForm 'frmAuswahl'. Ich denke der Code danach ist klar. Dann kommt
If .ListCount = 0 Then
'... Makro beenden
End
'Ansonsten...
Else
'... erstes Listenelement markieren
.ListIndex = 0
End If
End With
Also, wenn die LIstbox leer ist, soll das Makro beendet werden, wenn nicht, soll der erste Eintrag markiert werden. Zugleich sollte dann 'lstListbox' den Wert des Tabellenblattnamens annehmen, also hier 'Tabelle1', Der Wert bleibt allerdings immer bei null, wobei es dann bei
Set objBlatt = GetWorksheet(.lstListbox.Value)
auch zu einem Fehler kommt.
Ich weiß da irgendwie nicht weiter.
Würde mich freuen, wenn mir jemand weiterhelfen könnte.
Vielen Dank.
Gruß
Steffen
Hier der Code:

Sub test
'Das Tabellenblatt "Tabelle1" öffnen
Sheets("Tabelle1").Select
'Hier werden nun die belegten Zeilen gezählt
anzahl_der_teilnehmer = WorksheetFunction.Count(Sheets("Tabelle1").Range("B4:B65000").Value)
'On Error Resume Next
'Listenfelddialog frmAuswahl aufrufen
With frmAuswahl
'Fenstertiteltext festlegen
.Caption = "Drucken"
'Eingabeaufforderungstext festlegen
.lblPrompt.Caption = "Wählen Sie etwas:"
'Listenfeld konfigurieren
With .lstListbox
'Drei Spalten anlegen
.ColumnCount = 3
'Spaltenbreiten festlegen, erste unsichtbar
.ColumnWidths = "0;-1;-1"
iloop = 0
iRow = 4
For Each objBlatt In ActiveWorkbook.Worksheets
'Alle Spalten mit Namen durchlaufen
If objBlatt.Name = "Tabelle1" Then
Do
If Cells(iRow, 4) <> "X" Then
'... Blattnamen in unsichtbare erste Spalte schreiben
.AddItem objBlatt.Name
'Namen des Teilnehmers in erste Spalte schreiben
.List(.ListCount - 1, 1) = objBlatt.Cells(iRow, 1).Value
'Nächster Wert in zweite Spalte schreiben
.List(.ListCount - 1, 2) = objBlatt.Cells(iRow, 2).Value
End If
iRow = iRow + 1
iloop = iloop + 1
Loop While iloop < anzahl_der_teilnehmer
End If
Next
'Wenn Listenfeld leer ist, dann...
If .ListCount = 0 Then
'... Makro beenden
End
'Ansonsten...
Else
'... erstes Listenelement markieren
.ListIndex = 0
End If
End With
'Userform anzeigen
.Show
'Wenn Anwender 'Abbrechen' gewählt hat, dann...
If .Tag = "Abbruch" Then
'... Makro beenden
End
End If
Set objBlatt = GetWorksheet(.lstListbox.Value)
End With
End Sub



Function GetWorksheet(strName As String) As Worksheet
Dim objBlatt As Worksheet
'Alle Blätter der aktuelle Arbeitsmappe durchlaufen
For Each objBlatt In ActiveWorkbook.Worksheets
'Wenn Blatt mit angegebenem Namen gefunden, dann...
If objBlatt.Name = strName Then
'... Verweis auf Blatt zurückliefern
Set GetWorksheet = objBlatt
'Schleife verlassen
Exit For
End If
Next
End Function

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Probleme mit Listbox
Veit
Moin, Moin,
kann es sein, dass Dein Fehler in der With Zeile liegt? Denn
With UserForm1.lstListBox
If .ListCount = 0 Then
'... Makro beenden
Exit Sub
'Ansonsten...
Else
'... erstes Listenelement markieren
.ListIndex = 0
End If
End With
'funzt einwandfrei
'Gruß
'Ein Veit
AW: Probleme mit Listbox
Steffen
Hallo,
danke erstmal. Daran liegt es nicht. GerdZ hatte die richtige Idee. Ich habe bei der listbox multiselect gewählt. Deswegen geht es nicht.
Gruß
Seffen
AW: Probleme mit Listbox
GerdZ
Hallo Steffen,
ist für die lstListbox vielleicht die MultiSelect-Möglichkeit aktiviert?
Gruß
Gerd
Anzeige
AW: Probleme mit Listbox
Steffen
Hallo,
ja, ich habe multiselect eingestellt. Wenn ich es auf single stelle geht es. Es soll möglich sein, mehrere Einträge zu wählen und zwar aus dem Grund, dass ich dann die Werte an ein Word Dokument sende, dort in Textmarken eintragen und drucken lasse. Da ich einige ZEilen habe, soll man dann auf einmal mehrere wählen können, damit die Druckerei automatisch abläuft. Ich habe mal den ganzen Code, den ich dazu verfasst habe angehängt.
Wenn das wegen multiselect nicht geht, kann man das ganze dann auch noch anders lösen?
Danke erst mal.
Gruß
Steffen
Sub test
Dim objWord As Object
Dim objBlatt As Worksheet
Dim intI As Integer
Dim strTitel As String
Dim strLänge As String
Dim strTitelliste As String
Dim iRow As Integer
Dim iloop As Integer
Dim anzahl_der_teilnehmer As Integer
'Das Tabellenblatt "Tabelle1" öffnen
Sheets("Tabelle1").Select
'Hier werden nun die belegten Zeilen gezählt
anzahl_der_teilnehmer = WorksheetFunction.Count(Sheets("Tabelle1").Range("B4:B65000").Value)
'On Error Resume Next
'Listenfelddialog frmAuswahl aufrufen
With frmAuswahl
'Fenstertiteltext festlegen
.Caption = "Drucken"
'Eingabeaufforderungstext festlegen
.lblPrompt.Caption = "Wählen Sie etwas:"
'Listenfeld konfigurieren
With .lstListbox
'Drei Spalten anlegen
.ColumnCount = 3
'Spaltenbreiten festlegen, erste unsichtbar
.ColumnWidths = "0;-1;-1"
iloop = 0
iRow = 4
For Each objBlatt In ActiveWorkbook.Worksheets
'Alle Spalten mit Namen durchlaufen
If objBlatt.Name = "Tabelle1" Then
Do
If Cells(iRow, 4) "X" Then
'... Blattnamen in unsichtbare erste Spalte schreiben
.AddItem objBlatt.Name
'Namen des Teilnehmers in erste Spalte schreiben
.List(.ListCount - 1, 1) = objBlatt.Cells(iRow, 1).Value
'Nächster Wert in zweite Spalte schreiben
.List(.ListCount - 1, 2) = objBlatt.Cells(iRow, 2).Value
End If
iRow = iRow + 1
iloop = iloop + 1
Loop While iloop End If
Next
'Wenn Listenfeld leer ist, dann...
If .ListCount = 0 Then
'... Makro beenden
End
'Ansonsten...
Else
'... erstes Listenelement markieren
.ListIndex = 0
End If
End With

'Userform anzeigen
.Show

'Wenn Anwender 'Abbrechen' gewählt hat, dann...
If .Tag = "Abbruch" Then
'... Makro beenden
End
End If
Set objBlatt = GetWorksheet(.lstListbox.Value)
End With
'Userform anzeigen
.Show

'Wenn Anwender 'Abbrechen' gewählt hat, dann...
If .Tag = "Abbruch" Then
'... Makro beenden
End
End If
Set objBlatt = GetWorksheet(.lstListbox.Value)
End With
'Neue Instanz von Microsoft Word starten
Set objWord = CreateObject("Word.Application")
'Bei Misserfolg...
If objWord Is Nothing Then
'... Fehlermeldung ausgeben
MsgBox "Word kann nicht gestartet werden.", vbCritical, APP_NAME
'Bei Erfolg...
Else
With objWord
'Word sichtbar machen
.Visible = True

'Neues Dokument auf Grundlage von Urkunde.dot anlegen
.Documents.Add template:=.Options.DefaultFilePath(2) & "\test.dot"
'Bei Misserfolg...
If Err 0 Then
'... Fehlermeldung anzeigen
MsgBox "Bitte kopieren Sie die Dokumentvorlage Urkunde.dot in das folgende Verzeichnis: " & vbCr & .Options.DefaultFilePath(2), vbCritical, APP_NAME
'Word schließen
.Quit
'Objektvariable freigeben
Set objWord = Nothing
'Makro beenden
End
End If
MsgBox objBlatt.Name
'Textmarken der Inlay-Tabelle durch Albuminfos ersetzen
Call WordTextmarkeFüllen(objWord, .ActiveDocument, "Vorname", objBlatt.Cells(1, 2))
Call WordTextmarkeFüllen(objWord, .ActiveDocument, "Nachname", objBlatt.Cells(1, 2))
Call WordTextmarkeFüllen(objWord, .ActiveDocument, "Strecke", objBlatt.Cells(1, 2))

End With
'Objektvariable für Word-Zugriff freigeben (Word bleibt geöffnet)
Set objWord = Nothing
End If
'Makro beenden und alle Userform-Dialogfeldinhalte zurücksetzen
''End
End Sub
Function GetWorksheet(strName As String) As Worksheet
Dim objBlatt As Worksheet
'Alle Blätter der aktuelle Arbeitsmappe durchlaufen
For Each objBlatt In ActiveWorkbook.Worksheets
'Wenn Blatt mit angegebenem Namen gefunden, dann...
If objBlatt.Name = strName Then
'... Verweis auf Blatt zurückliefern
Set GetWorksheet = objBlatt
'Schleife verlassen
Exit For
End If
Next
End Function 

Private Sub WordTextmarkeFüllen(objWord As Object, objWDDokument As Object, strTMName As String, strTMWert As String)
'Wenn Textmarke existiert, dann...
If objWDDokument.Bookmarks.Exists(strTMName) = True Then
'... Textmarke markieren
objWDDokument.Bookmarks(strTMName).Range.Select
'Mit Inhalt überschreiben
objWord.Selection.Text = strTMWert
'Textmarke neu anlegen über neuem Inhalt
objWDDokument.Bookmarks.Add Range:=objWord.Selection.Range, Name:=strTMName
'Markierung aufheben
objWord.Selection.Collapse 0
End If
End Sub

Anzeige
AW: Probleme mit Listbox
GerdZ
Hallo Steffen,
im Prinzip geht das schon mit Multiselect. Dein Programm muß dann aber auch die Mehrfachauswahlmöglichkeit verarbeiten.
Beispiel dazu auf http://www.vbarchiv.net/faq/listbox_items2textbox.php
In der Schleife, wo die ausgewählten Listenelemente in die Textbox geschrieben werden, müßtest Du den Blattnamen ermitteln, die neue Worddatei erstellen und mit den Werten füllen.
Gruß
Gerd
Vielen Dank
Steffen
Hallo,
vielen Dank. Ich werde mal schauen, wie ich das dann löse.
Gruß
Steffen
Anzeige

Links zu Excel-Dialogen

ListBox TextBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige