Ist da nicht ein Loch in der Logik?
"Die Nr. darf wenn Sie schon einmal benutzt wurde und die Zeile evt. gelöscht wurde nicht wieder verwendet werden"
Soll heißen, die Zeile mit der höchsten Nummer, darf nie ................?
Egal, für gewöhnlich wird die zuletzt vergebene Nummer (dauerhaft) gespeichert und immer hochgezählt!
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
'******************************************************************************
' Name : Worksheet_BeforeDoubleClick / erstellt : 14.11.2014 / 18:40 / Sub
'------------------------------------------------------------------------------
'
' Klassenmodul der Tabelle - Ereignis
'
'******************************************************************************
'
AddIt Target
Cancel = True
End Sub
im Modul:
Option Explicit
Sub AddIt(myCell As Range)
'
'******************************************************************************
' Name : AddIt / erstellt : 21.01.2012 / 09:45 / Sub
'------------------------------------------------------------------------------
'
' nur wenn Zelle leer
'
'******************************************************************************
'
If Intersect(Columns("B"), myCell) Is Nothing _
Or myCell.Formula <> "" Then Exit Sub
'
myCell.Formula = Trim(myCell.Offset(0, -1).Formula) & _
Chr(45) & AddkMyPropertie
'
End Sub
Sub MkCustomProperties()
'
'******************************************************************************
' Name : MkCustomProperties / erstellt : 21.01.2012 / 09:32 / Sub
'------------------------------------------------------------------------------
'
' zum Einrichten ggf. Zurücksetzen
'
'******************************************************************************
'
Dim oWsh As Worksheet
Dim oCsp As CustomProperty
Set oWsh = ThisWorkbook.ActiveSheet
With oWsh
For Each oCsp In .CustomProperties
If oCsp.Name = "Anforderung" Then
Select Case MsgBox("auf Null setzen ?", _
vbYesNo Or vbExclamation Or vbDefaultButton1, _
"Metadaten vorhanden")
Case vbYes
oCsp.Delete
Case vbNo
Exit Sub
End Select
End If
Next oCsp
.CustomProperties.Add _
Name:="Anforderung", Value:=0
End With
Set oWsh = Nothing
End Sub
Function AddkMyPropertie() As String
'
'******************************************************************************
' Name : AddkMyPropertie / erstellt : 21.01.2012 / 09:33 / Function
'------------------------------------------------------------------------------
'
' bei Doppelklick
'
'******************************************************************************
'
Dim oWsh As Worksheet
Dim oCsp As CustomProperty
Set oWsh = ThisWorkbook.ActiveSheet
With oWsh
For Each oCsp In .CustomProperties
If oCsp.Name = "Anforderung" Then
oCsp.Value = oCsp.Value + 1
AddkMyPropertie = Format(oCsp.Value, "0000")
End If
Next oCsp
End With
Set oWsh = Nothing
End Function
Function ChkMyPropertie() As String
'
'******************************************************************************
' Name : ChkMyPropertie / erstellt : 21.01.2012 / 09:35 / Function
'------------------------------------------------------------------------------
'
' ggf.
'
'******************************************************************************
'
Dim oWsh As Worksheet
Dim oCsp As CustomProperty
Set oWsh = ThisWorkbook.ActiveSheet
With oWsh
For Each oCsp In .CustomProperties
If oCsp.Name = "Anforderung" Then _
ChkMyPropertie = Format(oCsp.Value, "0000")
Next oCsp
End With
Set oWsh = Nothing
End Function
|