AW: intelligente Tabelle VBA Code für Maske Dateneingabe
05.10.2024 18:21:32
Alwin Weisangler
Hallo Peter,
tausche diese 2 Prozeduren aus:
Private Sub Cmd_NeuerEintrag_Click()
Dim i&, arrZeile()
For i = 2 To 3
If Controls(arrControls(i)) = "" Then
MsgBox Controls(arrControls(i)).Name & " ist ein Pflichtfeld", vbInformation, "Problem Pflichtfeld"
Controls(arrControls(i)).SetFocus
Exit Sub
End If
Next i
ReDim arrZeile(1 To 1, 1 To UBound(arrControls) + 1)
For i = 1 To UBound(arrZeile, 2)
If i = 4 Or i = 8 Or i = 11 Then
If i = 4 Then
If IsNumeric(Controls(arrControls(i - 1))) Then
arrZeile(1, i) = CDbl(Controls(arrControls(i - 1)))
Else
arrZeile(1, i) = Controls(arrControls(i - 1))
End If
End If
If i = 8 And IsDate(Controls(arrControls(i - 1))) Then
arrZeile(1, i) = CDate(Controls(arrControls(i - 1)))
Else
arrZeile(1, i) = Controls(arrControls(i - 1))
End If
If i = 11 And IsDate(Controls(arrControls(i - 1))) Then
arrZeile(1, i) = CDate(Controls(arrControls(i - 1)))
Else
arrZeile(1, i) = Controls(arrControls(i - 1))
End If
Else
arrZeile(1, i) = Controls(arrControls(i - 1))
End If
Next i
With dynTab
'.ListRows.Add.Range.Resize(UBound(arrZeile)) = arrZeile
.ListRows.Add
For i = 1 To UBound(arrZeile, 2)
If Not i = 2 And Not i = 9 Then
With .DataBodyRange
.Cells(.Rows.Count, i) = arrZeile(1, i)
End With
End If
Next i
With .DataBodyRange.Cells(.ListRows.Count, SpaltePLZ)
.NumberFormat = "00000"
.RowHeight = 52.5
End With
End With
With ListBox1
.AddItem dynTab.ListRows.Count
.ListIndex = .ListCount - 1
For i = 1 To UBound(arrZeile, 2)
.List(.ListCount - 1, i) = arrZeile(1, i)
Next i
.ListIndex = -1
End With
For i = 0 To UBound(arrControls)
Controls(arrControls(i)).Value = ""
Next i
End Sub
Private Sub Cmd_EintragAendern_Click()
Dim i&, iZeile&, iIndex&, arrZeile()
ReDim arrZeile(1 To 1, 1 To UBound(arrControls) + 1)
If ListBox1.ListIndex = -1 Then
MsgBox "Kein Datensatz zum Ändern vorhanden", vbInformation, "Problem! Ändern"
Exit Sub
End If
iZeile = ListBox1.List(ListBox1.ListIndex, 0)
iIndex = ListBox1.ListIndex
If Schreibschutz = False Then
MsgBox "Es wurde kein Eintrag ausgewählt", vbInformation
Else
For i = 1 To UBound(arrZeile, 2)
If i = 4 Or i = 8 Or i = 11 Then
If IsNumeric(Controls(arrControls(i - 1))) Then
arrZeile(1, i) = CDbl(Controls(arrControls(i - 1)))
Else
arrZeile(1, i) = Controls(arrControls(i - 1))
End If
If i = 8 And IsDate(Controls(arrControls(i - 1))) Then
arrZeile(1, i) = CDate(Controls(arrControls(i - 1)))
Else
arrZeile(1, i) = Controls(arrControls(i - 1))
End If
If i = 11 And IsDate(Controls(arrControls(i - 1))) Then
arrZeile(1, i) = CDate(Controls(arrControls(i - 1)))
Else
arrZeile(1, i) = Controls(arrControls(i - 1))
End If
Else
arrZeile(1, i) = Controls(arrControls(i - 1))
End If
Next i
With dynTab.DataBodyRange
'.Rows(iZeile).Resize(UBound(arrZeile, 1), UBound(arrZeile, 2)) = arrZeile
For i = 1 To UBound(arrZeile, 2)
If Not i = 2 And Not i = 9 Then
.Cells(iZeile, i) = arrZeile(1, i)
End If
Next i
.Cells(iZeile, SpaltePLZ).NumberFormat = "00000"
End With
With ListBox1
For i = 1 To UBound(arrZeile, 2)
.List(.ListIndex, i) = arrZeile(1, i)
.ListIndex = -1
.ListIndex = iIndex
Next i
End With
'Schreibschutz = False
End If
End Sub
Gruß Uwe