Anzeige Listeneinträge
21.12.2017 08:46:29
Anders
Ich habe eine UserForm erstellt, über die man verschiedene Daten in verschiedene Worksheets eingeben kann. Das alles funktioniert auch sehr gut.
Ebenfalls in der Userform, möchte ich gerne die zuvor eingegebenen Daten in einer Listbox anzeigen lassen, um sie ggf. zu löschen oder zu editieren. Die Anzeige der Einträgefunktioniert auch. Leider habe ich nur das Problem, dass nicht alle Einträge angezeigt werden, sondern sich die Anzahl der anzuzeigenden Daten, an einem Worksheet orientiert, welches zuletzt ausgewählt wurde.
Wie kann ich da vorgehen?
Option Explicit
Dim nRow As Long
Dim bolEntryPossible As Boolean
Private Sub cmdAddEntry1_Click()
Dim lngNewRow2 As Long
Dim txtEnterEntry1Shortcut As String
Dim txtEnterEntry1 As String
'Aktivieren
Worksheets("Setup_Entry1").Activate
'Neue Reihe berechnen
lngNewRow2 = Cells(Rows.Count, 2).End(xlUp).Row + 1
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Select
ActiveCell.Offset(1, 0) = ActiveCell + 1
ActiveCell.Offset(1, 1) = Me.txtEnterEntry1Shortcut.Value
ActiveCell.Offset(1, 2) = Me.txtEnterEntry1.Value
Me.txtEnterEntry1Shortcut.Value = ""
Me.txtEnterEntry1.Value = ""
Unload Me
UserForm1.Show
End Sub
Sub cmdAddNewEntry_Click()
Dim check As Boolean
Dim k As Integer
Dim i As Integer
Dim total_rows As Integer
'Alles auf null setzen und Cursor positionieren
Call ClearAllTxtFields
Call NewRow
bolEntryPossible = True
txtID = nRow - 2
Me.cmbEntry1.SetFocus
End Sub
Private Sub MultiPage1_Change()
End Sub
Private Sub UserForm_Activate()
Call ClearAllTxtFields
'Tabellennamen bei Bedarf anpassen
Call NewRow
txtID = nRow - 2
bolEntryPossible = True
End Sub
Sub cmdSaveEntry_Click()
Dim lngNewRow1 As Long
Dim txtID As Integer
Dim Entry1 As String
Dim Entry2 As String
Dim Entry3 As String
Dim Entry4 As String
Dim Entry5Year As Integer
Dim Entry5Month As Byte
Dim Entry5Day As Byte
Dim Entry3Question As String
Dim Entry3Quantifier As String
Dim Entry6 As String
Dim Value1 As Integer
Dim Value2 As Integer
Dim Value3 As Integer
Dim Value4 As Integer
Dim Value5 As Integer
If bolEntryPossible Then
Entry1 = (cmbEntry1)
Entry2 = (cmbEntry2)
Entry3 = (cmbEntry3)
Entry4 = (cmbEntry4)
Entry5Year = (cmbEntry5Year)
Entry5Month = (cmbEntry5Month)
Entry5Day = (cmbEntry5Day)
Entry3Question = (cmbEntry3Question)
Entry3Quantifier = (cmbEntry3Quantifier)
Entry6 = (cmbEntry6)
Value1 = (txtValue1)
Value2 = (txtValue2)
Value3 = (txtValue3)
Value4 = (txtValue4)
Value5 = (txtValue5)
With Sheets("ValueDatabase")
.Cells(nRow, "A") = nRow - 2
.Cells(nRow, "B") = Entry1
.Cells(nRow, "C") = Entry2
.Cells(nRow, "D") = Entry3
.Cells(nRow, "E") = Entry4
.Cells(nRow, "F") = Entry5Year
.Cells(nRow, "G") = Entry5Month
.Cells(nRow, "H") = Entry5Day
.Cells(nRow, "J") = Entry3Question
.Cells(nRow, "K") = Entry3Quantifier
.Cells(nRow, "L") = Entry6
.Cells(nRow, "M") = Value1
.Cells(nRow, "N") = Value2
.Cells(nRow, "O") = Value3
.Cells(nRow, "P") = Value4
.Cells(nRow, "Q") = Value5
End With
Call ClearAllTxtFields
Call NewRow
bolEntryPossible = False
Else
If MsgBox("Soll ein neuer Datensatz eingegeben werden?", vbQuestion + vbYesNo,
"Derzeit keine Eingabe möglich") = vbYes Then bolEntryPossible = True
End If
End Sub
Sub ClearAllTxtFields()
Dim o As Object
With Me
With .cmbEntry1
Worksheets("Setup_Entry1").Activate
cmbEntry1.RowSource = "Setup_Entry1!C3:C" & Range("A" & Rows.Count).End(xlUp).Row
End With
With .cmbEntry2
Worksheets("Setup_Entry2").Activate
cmbEntry2.RowSource = "Setup_Entry2!C3:C" & Range("A" & Rows.Count).End(xlUp).Row
End With
With .cmbEntry3
Worksheets("Setup_Entry3").Activate
cmbEntry3.RowSource = "Setup_Entry3!B3:B" & Range("A" & Rows.Count).End(xlUp).Row
End With
With .cmbEntry4
Worksheets("Setup_Entry4").Activate
cmbEntry4.RowSource = "Setup_Entry4!B3:B" & Range("A" & Rows.Count).End(xlUp).Row
End With
With .cmbEntry5Year
cmbEntry5Year.List = Array("2014", "2015", "2016", "2017", "2018", "2019", "2020")
End With
With .cmbEntry5Month
cmbEntry5Month.List = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", _
"11", "12")
End With
With .cmbEntry5Day
cmbEntry5Day.List = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", " _
11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31")
End With
With .cmbEntry3Question
Worksheets("Setup_Entry3Question").Activate
cmbEntry3Question.RowSource = "Setup_Entry3Question!B3:B" & Range("A" & Rows.Count).End( _
xlUp).Row
End With
With .cmbEntry3Quantifier
cmbEntry3Quantifier.List = Array("high", "medium", "low")
End With
With .cmbEntry6
Worksheets("Setup_Entry6").Activate
cmbEntry6.RowSource = "Setup_Entry6!B3:B" & Range("A" & Rows.Count).End(xlUp).Row
End With
End With
'lbEntry1Overview
lbEntry1Overview.RowSource = "Setup_Entry1!A3:C" & Range("A" & Rows.Count).End(xlUp).Row
'lbEntry3Overview
lbEntry3Overview.RowSource = "Setup_Entry3!A3:B" & Range("A" & Rows.Count).End(xlUp).Row
'lbEntry3QuestionOverview
lbEntry3QuestionOverview.RowSource = "Setup_Entry3Question!A3:B" & Range("A" & Rows.Count).End( _
xlUp).Row
'lbEntry6Overview
lbEntry6Overview.RowSource = "Setup_Entry6!A3:G" & Range("A" & Rows.Count).End(xlUp).Row
'lbEntry2OverviewOverview
lbEntry2Overview.RowSource = "Setup_Entry2!A3:C" & Range("B" & Rows.Count).End(xlUp).Row
'lbEntry2OverviewOverview
lbEntry4Overview.RowSource = "Setup_Entry4!A3:C" & Range("B" & Rows.Count).End(xlUp).Row
End Sub
Sub NewRow()
nRow = Sheets("ValueDatabase").Cells(Rows.Count, 1).End(xlUp).Row + 1
End Sub