Listbox Click Event

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim rLaubt As Range 'Definition des Bereiches, in dem Änderungen erlaubt sind Set rLaubt = Range("B3:B19") 'Überprüfe, ob erlaubter Bereich und aktive Zelle eine Schnittmenge haben If Not Intersect(rLaubt, ActiveCell) Is Nothing Then 'schreibe Inhalt der ListBox in die aktive Zelle ActiveCell.Value = ListBox1.Value End If 'Focus wieder auf das Tabellenblatt setzen ActiveCell.Activate '(auskommentieren, falls nicht gewünscht) End Sub

Private Sub UserForm_Initialize() Dim L As Long With lb_grp1 .MultiSelect = fmMultiSelectSingle .ListStyle = fmListStylePlain End With For L = 1 To 443 If Sheets("Import").Cells(L, 4) "" Then _ lb_grp1.AddItem Sheets("Import").Cells(L, 4) Next End Sub

Hallo Christopher,
Ich blick nicht so ganz wie man hier antwortet also hoffe ich es klappt ;)
Hat geklappt, allerdings bist du eine Hierachieebene zu hoch gelandet - du hast dir quasi selber geantwortet. Click das nächste Mal auf die Antwort, auf die du Antworten möchtest, und dann auf Antwort Erstellen - eventuell mit einem neuem, besserem Betreff.
Beide Lösungen haben tadellos funktioniert.
Danke für die Rückmeldung!
Muss das in ein Modul oder in ein Sheet?
Das, was du gefunden hast, hat so gar nichts mit der Listbox zu tuen die du verwendest. Das ganze zielt auf eine USERFORM ab, zu erkennen an der Zeile
Private Sub UserForm_Initialize()
Lob und Anerkennung, dass du recherchiert hast - aber der Einfachkeit halber, beschreib mal was du haben willst. Ich rate: Die ListBox soll aus einem Bereich (zB A1:A100) gefüllt werden, dabei sollen aber Leerzeilen innerhalb dieses Bereiches ignoriert werden?
Warum wird nach Option Explicit eine Trennlinie eingefügt?
Weil Option Explicit nicht zum Makro gehört, sondern zum Modul. Schreibst du mehrere Makros und/oder Funktionen in ein Modul, werden diese auch getrennt. Die bessere Frage wär: "Was ist Option Explicit und wozu ist es gut?".
Die Antwort darauf gleich hinterher: Es verhindert, dass beim Programmieren blöde Tippfehler passieren indem es alle Variablen auf Deklaration prüft. Etwas sachlicher und ausführlicher hier:
http://www.online-excel.de/excel/singsel_vba.php?f=4
Merke: Option Explicit hilft zwar nicht immer, schadet aber nie.
Grüße,
Klaus M.vdT.

Sub FillListBoxIgnoreBlanks() Dim wksSource As Worksheet Dim rSource As Range Dim rListIt As Range Set wksSource = Sheets("Sheet1") 'anpassen Set rSource = wksSource.Range("A1:A18") 'anpassen 'eventuell alte Listboxeinträge löschen ListBox1.Clear For Each rListIt In rSource If rListIt.Value = "" Then 'wenn leer, mache nix Else 'Zelleninhalt in die Listbox packen ListBox1.AddItem rListIt.Value End If Next rListIt End Sub

Sorry dass ich das nicht erwähnt hatt. Ich wusste nicht dass das wichtig ist. Ich weiss erst seit letzter Woche dass man Listen auch anders als mit Dokumentenprüfung darstellen kann O.o Ursprünglich habe ich diese benutzt nur leider kann mann die breite nicht verändern somit ist für den Anwender zu wenig ersichtlich beim Stundenzettel ausfüllen.
Das einzige Modul in meiner Datei enthält diesen Code:
Option Explicit
Sub FillListBoxIgnoreBlanks()
Dim wksSource As Worksheet
Dim rSource As Range
Dim rListIt As Range
Set wksSource = Sheets("Import") 'anpassen
Set rSource = wksSource.Range("D1:D443") 'anpassen
'eventuell alte Listboxeinträge löschen
ListBox1.Clear
For Each rListIt In rSource
If rListIt.Value = "" Then
'wenn leer, mache nix
Else
'Zelleninhalt in die Listbox packen
ListBox1.AddItem rListIt.Value
End If
Next rListIt
End Sub
Sub Druck1()
'
' Druck1 Makro
'
'
With ActiveSheet.PageSetup
.PaperSize = xlPaperA4
.PrintArea = "$DH$78:$EG$147"
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Columns("DD:FM").EntireColumn.Hidden = False
ActiveSheet.PrintPreview
Columns("DD:FM").EntireColumn.Hidden = True
Range("G10").Select
End Sub
Sub Druck2()
'
' Druck2 Makro
'
'
With ActiveSheet.PageSetup
.PaperSize = xlPaperA4
.PrintArea = "$EK$78:$FJ$147"
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
End With
Columns("DD:FM").EntireColumn.Hidden = False
ActiveSheet.PrintPreview
Columns("DD:FM").EntireColumn.Hidden = True
Range("G10").Select
End Sub
Sub Druck3()
'
' Druck3 Makro
'
'
With ActiveSheet.PageSetup
.PaperSize = xlPaperA3
.PrintArea = "$A$1:$CQ$41"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 2
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
End With
Columns("DD:FM").EntireColumn.Hidden = False
ActiveSheet.PrintPreview
Columns("DD:FM").EntireColumn.Hidden = True
Range("G10").Select
End Sub
Sub Druck4()
'
' Druck1 Makro
'
'
With ActiveSheet.PageSetup
.PaperSize = xlPaperA4
.PrintArea = "$A$1:$P$60"
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveSheet.PrintPreview
Range("G10").Select
End Sub Alle anderen Tabellenblätter enthalten den gleichen Code:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim rLaubt As Range
'Definition des Bereiches, in dem Änderungen erlaubt sind
Set rLaubt = Range("AC9:CQ9")
'Überprüfe, ob erlaubter Bereich und aktive Zelle eine Schnittmenge haben
If Not Intersect(rLaubt, ActiveCell) Is Nothing Then
'schreibe Inhalt der ListBox in die aktive Zelle
ActiveCell.Value = ListBox1.Value
End If
'Focus wieder auf das Tabellenblatt setzen
ActiveCell.Activate '(auskommentieren, falls nicht gewünscht)
End Sub

Private Sub Worksheet_Activate()
ActiveSheet.Protect userinterfaceonly:=True, Password:="adelholzner"
ActiveSheet.EnableOutlining = True
ActiveSheet.EnableAutoFilter = True
"Hier hab ich es mit Call FillListBoxIgnoreBlanks probier"
End Sub

Sub Druck1() Call DruckEs(xlPaperA4, "$DH$78:$EG$147", xlPortrait, 1, 1, True, False) 'Druck 1 End Sub Sub druck2() Call DruckEs(xlPaperA4, "$EK$78:$FJ$147", xlPortrait, 1, 1, True, True) 'Druck 2 End Sub Sub druck3() Call DruckEs(xlPaperA3, "$A$1:$CQ$41", xlLandscape, 2, 1, False, True) 'Druck 3 End Sub Sub Druck4() Call DruckEs(xlPaperA4, "$A$1:$P$60", xlPortrait, 1, 1, False, False) 'Druck 4 End Sub Sub DruckEs(sPaperSize As String, sPrintArea As String, sOrientation As String, iFitWide As _ Integer, iFitTall As Integer, bUnhideCol As Boolean, bCenter As Boolean) With ActiveSheet.PageSetup .PaperSize = sPaperSize .PrintArea = sPrintArea .Orientation = sOrientation .Zoom = False .FitToPagesWide = iFitWide .FitToPagesTall = iFitTall .CenterHorizontally = bCenter .CenterVertically = bCenter End With With ActiveSheet .Columns("DD:FM").Hidden = Not bUnhideCol .PrintPreview .Columns("DD:FM").Hidden = True End With End Sub

Private Sub Worksheet_Activate() ActiveSheet.Protect userinterfaceonly:=True, Password:="adelholzner" ActiveSheet.EnableOutlining = True ActiveSheet.EnableAutoFilter = True "Hier hab ich es mit Call FillListBoxIgnoreBlanks probiert" End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim rLaubt As Range 'Definition des Bereiches, in dem Änderungen erlaubt sind Set rLaubt = Range("AC9:CQ9") 'Überprüfe, ob erlaubter Bereich und aktive Zelle eine Schnittmenge haben If Not Intersect(rLaubt, ActiveCell) Is Nothing Then 'schreibe Inhalt der ListBox in die aktive Zelle ActiveCell.Value = ListBox1.Value End If 'Focus wieder auf das Tabellenblatt setzen ActiveCell.Activate '(auskommentieren, falls nicht gewünscht) End Sub

Beliebteste Forumthreads (12 Monate)

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

13 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Listbox Click Event

24 Beiträge zum Forumthread Beiträge zu diesem Forumthread

13 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread