Listbox Click Event

Christopher · 2013-02-25T07:22:24+00:00

Hallo Leute, ich habe ein kleineres Problem. Ich habe eine Listbox mit Auftragsnummern. Im Moment ist mein Code sehr einfach Private Sub ListBox1_Click() ActiveCell = ListBox1 End Sub Ich möchte aber gerne dass die Auftragsnummern nur in einen bestimmten Zellbereich eingetragen werden können. Das geht nicht über Zellschutz da auch andere Zeilen, z.b. die mit den Zeiten, ungeschützt sind. Desweiteren bekomm ich es einfach nicht gebacken dass man die Auftragsnummern in der Listbox mit einem Doppelklick übertragen muss. Im Moment reicht ein einfacher Klick und die Position wird in die Aktive zelle übertragen. Das ist sehr blöd, denn beim Öffnen der Datei wird automatisch der in der Listbox makierte Wert in die Aktuelle Zelle übertragen. Zusammenfassung: -Inhalte der Listbox sollen nur in einen bestimmten Zellbereich eingetragen werden können -Das ganze durch Doppelklick Viele Dank schonmal !!

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

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

Forumthread: Listbox Click Event

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial