Hallo Andrea,
nimm den folgenden Code un ersetze damit den Unicounter
Aber Achtung: diese Version ist nur für Deine Anforderungen!
Public Function UniCounter_New(intNoLen As Integer, strTabName As String, _
strFeldName As String, _
boolStart As Boolean, boolAlign As Boolean, _
Optional strArg As String = "-", _
Optional strArg2 As String = "", _
Optional dtStart As Date) As String
On Error GoTo ErrHandler
Dim strBedingung As String
Dim strNo As String, strDate As String
Dim strMax, intLenStr As Integer
Dim strAlignment As String
Dim intLenPrefix As Integer
Dim dtTemp As Date, sMonth As String
If dtStart = 0 Then
dtTemp = Date
Else
dtTemp = dtStart
End If
sMonth = Format(Month(dtTemp), "00")
strDate = Format(dtTemp, "yy")
' Länge des Datumstrings
intLenStr = Len(strDate)
strAlignment = "RIGHT"
strBedingung = strAlignment & "([" & strFeldName & "]," & _
intLenStr & ")='" & strDate & "'"
' Letzen Wert suchen
strMax = Left(DMax(strFeldName, strTabName, strBedingung), 4)
If IsNull(strMax) Then
' Start mit 0 oder 1
If boolStart = False Then
strNo = String$(intNoLen, "0")
Else
strNo = String$(intNoLen - 1, "0") & "1"
End If
Else
strNo = Left(strMax, intNoLen)
' Zähler setzen
strNo = Format$(Val(strNo) + 1, String$(intNoLen, "0"))
End If
' Zählerstring zusammensetzen
UniCounter_New = strNo & sMonth & strDate
ExitHere:
Exit Function
ErrHandler:
Dim strErrString As String
strErrString = "Error Information..." & vbCrLf
strErrString = strErrString & "Error#: " & Err.Number & vbCrLf
strErrString = strErrString & "Description: " & Err.Description
MsgBox strErrString, vbCritical + vbOKOnly, "Function: Unicounter_New"
Resume ExitHere
End Function
Aufruf:
UniCounter_New(4;"DeineTabelle";"DeinFeld";Wahr;Falsch;"";"")
