Hallo fat61
Ja, ja und Ja. Es wird ein Zufallscode erzeugt. Ist dieser bereits vorhanden, so wird ein anderer Code erzeugt. So werden Dubletten vermieden. Es wird geprüft ob sich der Code bereits auf dem Blatt befindet, dabei ist es irrelevant, ob der Code von dir oder vom Makro erzeugt wurde. Allerdings funktioniert Code2 nur mit einer Spalte (hier SpalteA). Wenn du das auf mehrere Spalten verteilt haben willst, brauchst du diesen Code:
Option Explicit
Sub CodeErzeugen3()
Dim Max As Long, Spalte As Long, z As Long, Start As Single, p As Byte
Dim code As String, zchn As String, anzahl As Long
Dim Codepos As Range, Codesheet As Worksheet, c As Range
Randomize Timer
Max = 42875
Sheets("Formular").Select
Set Codepos = Sheets("Formular").Range("B1") 'wo im Formular soll der Code stehen?
Set Codesheet = Sheets("AllUsedCodes") 'wie heißt das Blatt, wo alle bereits
'verwendeten Codes aufgelistet sind?
Do 'Abfrage nach Anzahl
anzahl = Val(InputBox("Wie viele Formulare wollen Sie heute drucken"))
Loop Until CLng(anzahl) >= 0
'Spalte ermitteln
Set c = Codesheet.Cells.Find(Date)
If c Is Nothing Then
Spalte = Codesheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
Codesheet.Cells(1, Spalte) = Date
Else
Spalte = c.Column
End If
For z = 1 To anzahl
If Application.CountA(Codesheet.UsedRange) = Max Then Exit For
Start = Timer
Do
If Timer > Start + 30 Then Exit Sub 'Timeout wenn nach 30 Sek. noch
'kein unbenutzter Code gefunden wurde
code = "" 'Code erzeugen
For p = 1 To 3
Do
zchn = Int(Rnd * 42) + 49
Loop Until Chr(zchn) Like "[A-Z]" Or Chr(zchn) Like "[1-9]"
code = code & Chr(zchn)
Next p
Loop Until Codesheet.UsedRange.Find(code) Is Nothing 'Dubletten haben keine Chance
With Codesheet.Cells(Rows.Count, Spalte).End(xlUp).Offset(1, 0)
.NumberFormat = "@"
.Value = code
End With
Codepos.Value = code
Sheets("Formular").PrintOut
Next z
MsgBox "Geschafft"
End Sub
Der Code fragt zunächst die Anzahl der Drucke ab. Jeder Druck mit einem anderen Code. Dann wird die Spalte ermittelt in der die Codes eingetragen werden. Dann wird der Code erzeugt und das gesamte Blatt überprüft ob dieser Code bereits irgendwo vorhanden ist. Wenn ja wird einfach ein neuer Code erzeugt und zwar solange, bis man einen gültigen unbenutzten Code hat. Einziger Nachteil: Je näher du der Obergrenze von 42875 Möglichkeiten kommst, umso länger dauert es, einen nicht benutzten Code zu finden. Deshalb hab ich einen Timeout eingebaut, der nach 30 Sekunden ungültigen Code-Erzeugens Schluss macht. Den kannst du aber auch erhöhen, wenn er zu früh aufgibt.
Außerdem habe ich gleich deinen Wunsch 3 aus der vorherigen Antwort eingearbeitet. Die Parameter des Printout-Befehls kannst du bei Wunsch mit dem Makrorekorder aufzeichnen und ergänzen.
Gruß Mr. K.