Thema Datum  Von Nutzer Rating
Antwort
14.11.2014 08:41:52 bkoehler
NotSolved
Blau Nummergenerierung (Nummernkreis)
14.11.2014 19:03:13 Gast86334
NotSolved
14.11.2014 19:49:10 bkoehler
NotSolved
14.11.2014 20:07:57 Gast67237
NotSolved
14.11.2014 20:38:33 Gast40637
NotSolved

Ansicht des Beitrags:
Von:
Gast86334
Datum:
14.11.2014 19:03:13
Views:
691
Rating: Antwort:
  Ja
Thema:
Nummergenerierung (Nummernkreis)

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

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
14.11.2014 08:41:52 bkoehler
NotSolved
Blau Nummergenerierung (Nummernkreis)
14.11.2014 19:03:13 Gast86334
NotSolved
14.11.2014 19:49:10 bkoehler
NotSolved
14.11.2014 20:07:57 Gast67237
NotSolved
14.11.2014 20:38:33 Gast40637
NotSolved