Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Speichern unter mit Nummernvergabe... | Herbers Excel-Forum


Betrifft: Speichern unter mit Nummernvergabe... von: Urmila
Geschrieben am: 14.01.2010 11:14:34

Hallo alle zusammen,

nun wieder ein Problem. Aber etwas was ich nciht wirklich im Netz finden konnte, habe bereits einige Codes verwendet und bin nun doch auf euch angewiesen :)

Also, ich habe eine Exceldatei auf dem Server, welche dann eben viele verschiedene User zu einem Zeitpunkt zugreifen könnten. Die Datei ist ein Formular, was der User ausfüllen soll und dann das Formular separat abspeichern soll (die Inhalte aus dem Formular werden im separaten Formular "ohne VBA Skripte" geschrieben). Der Ordner, in dem die separaten Formulare (ohne VBA Skripte) abgespeichert werden sollen, ist "C:\Test\Formulare\", die Bennenung von den Datei soll wie folgt aussehen: Form-001-Datum.xls

Die Zahl nach Form (000) soll sich jeweils um 1 erhöhen, doch soll etwas berücksichtigt werden, und zwar soll erst geprüft werden, ob es eine Lücke gibt bei den Zahlen, wenn ja, soll erst die Zahl genommen werden (also z.B. 001, 002, 003, 006, 007... - dann erst die 004 und dann die 005 und dann die 008 usw.)

Ich hoffe ich war verständlich...

Danke und LG
Urmila

  

Betrifft: Rückfrage von: Josef Ehrensberger
Geschrieben am: 14.01.2010 11:31:04

Hallo Urmila,

soll die lfd. Nummer je Datum wieder bei 1 beginnen, oder soll sei, unabhängig vom Datum,
immer erhöht werden?


Gruß Sepp



  

Betrifft: AW: Speichern unter mit Nummernvergabe... von: Reinhard
Geschrieben am: 14.01.2010 11:33:15

Hallo Urmilla,

vielelicht so:

Sub nn()
Dim N As Integer
N = 1
While Dir("C:\Test\Formulare\Form-" & Right("000" & N & "-", 4) & Date & ".xls") <> ""
   N = N + 1
Wend
MsgBox "C:\Test\Formulare\Form-" & Right("000" & N & "-", 4) & Date & ".xls"
End Sub

Gruß
Reinhard


  

Betrifft: Mein Vorschlag von: Rudi Maintaire
Geschrieben am: 14.01.2010 11:40:40

Hallo,

Option Explicit

Sub tt()
  Dim sDatei As String
  Const sPfad As String = "c:\test\"
  Const sMatch As String = "Form-???-*.xls"
  
  sDatei = sPfad & "\Form-" & Format(NextNumber(sPfad, sMatch), "000") & "-" & Format(Date, " _
YYYYMMDD") & ".xls"
  MsgBox sDatei
  
End Sub

Function NextNumber(sPfad As String, sMatch As String) As Integer
  Dim oNum As Object, sDatei As String, arrTmp, i As Integer
  sDatei = Dir(sPfad & sMatch)
  Set oNum = CreateObject("scripting.dictionary")
  Do While sDatei <> ""
    oNum.Add sDatei, CInt(Split(sDatei, "-")(1))
    sDatei = Dir
  Loop
  arrTmp = oNum.items
  QuickSort arrTmp
  For i = LBound(arrTmp) To UBound(arrTmp) - 1
    If arrTmp(i + 1) <> arrTmp(i) + 1 Then
      NextNumber = arrTmp(i) + 1
      Exit Function
    End If
  Next
  If NextNumber = 0 Then NextNumber = arrTmp(UBound(arrTmp)) + 1
End Function

Sub QuickSort(ByRef VA_Array, Optional V_Low1, Optional V_High1)
    On Error Resume Next
    Dim V_Low2 As Long, V_High2 As Long
    Dim V_Val1, V_Val2 As Variant
    If IsMissing(V_Low1) Then
        V_Low1 = LBound(VA_Array, 1)
    End If
    If IsMissing(V_High1) Then
        V_High1 = UBound(VA_Array, 1)
    End If
    V_Low2 = V_Low1
    V_High2 = V_High1
    V_Val1 = VA_Array((V_Low1 + V_High1) / 2)
    While (V_Low2 <= V_High2)
        While (VA_Array(V_Low2) < V_Val1 And _
            V_Low2 < V_High1)
            V_Low2 = V_Low2 + 1
        Wend
        While (VA_Array(V_High2) > V_Val1 And _
            V_High2 > V_Low1)
            V_High2 = V_High2 - 1
        Wend
        If (V_Low2 <= V_High2) Then
            V_Val2 = VA_Array(V_Low2)
            VA_Array(V_Low2) = VA_Array(V_High2)
            VA_Array(V_High2) = V_Val2
            V_Low2 = V_Low2 + 1
            V_High2 = V_High2 - 1
        End If
    Wend
    If (V_High2 > V_Low1) Then Call _
        QuickSort(VA_Array, V_Low1, V_High2)
    If (V_Low2 < V_High1) Then Call _
        QuickSort(VA_Array, V_Low2, V_High1)
End Sub

Gruß
Rudi


  

Betrifft: hat geklappt, danke Josef, Reinhard & Rudi von: Urmila
Geschrieben am: 14.01.2010 12:34:47

@ Josef

das habe ich natürlich vergessen zusagen, aber es hat sich erledigt (die zahl sollte sich einfach hoch zählen bzw. die lücke herausfinden....

danke und lg
Urmila


Beiträge aus den Excel-Beispielen zum Thema "Speichern unter mit Nummernvergabe..."