Option
Explicit
Sub
Test()
Call
ResetUID
Debug.Print
"prev: "
; GetLastUID(),
"new: "
; CreateUID()
Debug.Print
"prev: "
; GetLastUID(),
"new: "
; CreateUID()
Debug.Print
"prev: "
; GetLastUID(),
"new: "
; CreateUID()
Debug.Print
"prev: "
; GetLastUID(),
"new: "
; CreateUID()
Debug.Print
"prev: "
; GetLastUID(),
"new: "
; CreateUID()
End
Sub
Public
Function
CreateUID(
Optional
Format =
"0000"
)
As
String
Dim
i
As
Long
Call
LastUID(i)
CreateUID = VBA.Format$(i + 1, Format)
Call
LastUID(i + 1, 1)
End
Function
Public
Function
GetLastUID(
Optional
Format =
"0000"
)
As
String
Dim
i
As
Long
Call
LastUID(i)
GetLastUID = VBA.Format$(i, Format)
End
Function
Public
Sub
ResetUID()
Call
LastUID(0, 1)
End
Sub
Private
Sub
LastUID(
ByRef
UID
As
Long
,
Optional
Action)
Dim
objName
As
Excel.Name
On
Error
Resume
Next
Set
objName = Worksheets(
"Tabelle1"
).Names(
"__UID_LAST"
)
On
Error
GoTo
0
If
objName
Is
Nothing
Then
_
Set
objName = Worksheets(
"Tabelle1"
).Names.Add(Name:=
"__UID_LAST"
, RefersTo:=0)
If
IsMissing(Action)
Then
UID = Application.Evaluate(objName.Value)
ElseIf
Action = 1
Then
objName.RefersTo = UID
Else
UID = Application.Evaluate(objName.Value)
End
If
End
Sub