Hallo liebes VBA-Forum,

ich hab folgendes Problem, ich habe ein bestehendes VBA Makro für den Seriendruck eines Worddokumentes mit einem Zähler, der sich entsprechend der Anzahl der Druckexemplare hochzählt.

Jetzt muss ich das Dokument aber noch dahingehend abändern, dass beim Vorschriftentyp "Verpackungsvorschrift" die Anzahl Exemplare ignoriert werden und die Inhaltprüfung des eingegeben Schlüssels ignoriert werden.

...sprich die Eingabe desChargenschlüssel kann beliebig aus Zahlen oder Buchstaben oder sogar beidem bestehen, da bei der Auswahl der Verpackungsvorschrift das hochzählen nicht notwendig ist.

Wer kann mir hierbei helfen?

Private Const TitelHV = "Drucken der HV mit Produkt-Nr."
Private Const TitelVV = "Drucken der Verpackungsvorschrift mit Produkt-Nr."
Private Const SchluesselAuswahl = "Auswahl des Chargenschlüssels"
Private Const TitelAuswahl = "Auswahl des Chargentyps"
Private Const Zeiger = "@Nummer"

Private Projekt As String

Sub HV_Druck()
  Dim dlg As Dialog, ChargenNummer As String, ChargenBuchstabe As String, Charge As String, ChargenTyp As String, ChargenSchluessel As String, ChargenDefault As String, ProduktDefault As String, VorschriftenTypProduktion As Boolean, VorschriftenTypVerpackung As Boolean
  Set dlg = Dialogs(wdDialogFilePrint)
  ChargenSchluessel = "P"
  ChargenDefault = "0"
  ProduktDefault = "00000"
  ChargenBuchstabe = "A"
  fdbk = dlg.Display
  If Not fdbk = -1 Then Exit Sub
  Kopien = dlg.NumCopies
  dlg.NumCopies = 1
  Antw = NummerHolen
  If Antw < 0 Then Exit Sub
  
 'Hier wird die Auswahl des Vorschriftentyps bestimmt
 strM = "welchen Vorschriftentyp möchten Sie verwenden?" & vbCrLf & vbCrLf & "Bitte tragen Sie ihre Auswahl im Eingabefeld ein:" & vbCrLf & vbCrLf & "Vorschriftentyp= P     HV: Produktion" & vbCrLf & "Vorschriftentyp= V     HV: Verpackung"
 Antw = ChargenSchluessel
 Antw = InputBox(strE & strM, SchluesselAuswahl, Antw)
  If Antw = "P" Then ChargenBuchstabe = "A" & VorschriftenTypProduktion = True & VorschriftenTypVerpackung = False
  If Antw = "V" Then ChargenBuchstabe = "" & VorschriftenTypProduktion = False & VorschriftenTypVerpackung = True
  
  
    
  'Hier wir die Abgefragt, welcher Chargentyp es sein soll (Normalcharge, Validierungscharge, Entwicklungscharge....)
  strM = "um welchen Chargentyp handelt es sich hier?" & vbCrLf & vbCrLf & "Bitte tragen Sie ihre Auswahl im Eingabefeld ein:" & vbCrLf & vbCrLf & "Normalcharge= 0                         Kennzeichen: ohne" & vbCrLf & "Validierungscharge= 1                 Kennzeichen: -V" & vbCrLf & "Entwicklungscharge= 2                Kennzeichen: -E" & vbCrLf & "Technische Charge= 3                 Kennzeichen: -T" & vbCrLf & "Optimierungscharge= 4               Kennzeichen: -O" & vbCrLf & "Auf-/Umgearbeitete Charge= 5   Kennzeichen: -A"
  Antw = ChargenDefault
  Antw = InputBox(strE & strM, TitelAuswahl, Antw)
    If Antw = "0" Then ChargenTyp = ""
    If Antw = "1" Then ChargenTyp = "-V"
    If Antw = "2" Then ChargenTyp = "-E"
    If Antw = "3" Then ChargenTyp = "-T"
    If Antw = "4" Then ChargenTyp = "-O"
    If Antw = "5" Then ChargenTyp = "-A"
     
  '-->Hier wird die erste PA-Nummer in einer Inputbox eingetragen und bei Bedarf hochgezählt
  
 If VorschriftenTypProduktion Then
    strM = "Mit welcher Produkt-Nr. soll der Druck beginnen?" & vbCrLf & vbCrLf & "Achtung: Bitte nur die PA-Nummer ohne den Buchstabe eintragen!" & vbCrLf & vbCrLf & "ZJnnnn Beispiel: für den Produktionsauftrag A00021 bitte nur 00021 eintragen ohne das Kennzeichen A!"
    Antw = ProduktDefault
        While Not bFlag
            Antw = InputBox(strE & strM, TitelHV, Antw)
            If Antw = "" Then Exit Sub
            For i = 1 To Len(Antw)
            If Not Mid(Antw, i, 1) Like "[0-9]" Then
                strE = "Das ist keine gültige Zahl." & vbCr & vbCr
                bFlag = False: Exit For
            Else
                bFlag = True
            End If
            Next i
        Wend
    ChargenNummer = Val(Antw)
    For i = 1 To Kopien
        ChargenNummerFormatiert = Format(ChargenNummer, "00000")
        Charge = ChargenBuchstabe + ChargenNummerFormatiert + ChargenTyp
        NummerEinbringen Charge
        On Error Resume Next
        dlg.Execute
        rc = Err.Number
        On Error GoTo 0
        If rc > 0 Then
        strM = "Beim Drucken ist folgender Fehler aufgetreten:" & vbCr & vbCr
        strM = strM & "RC: (" & rc & ")" & vbCr & Error(rc)
        MsgBox strM, vbExclamation, TitelHV
        Exit Sub
        Else
        ChargenNummer = ChargenNummer + 1
        End If
    Next i
    strM = "Es wurden " & i - 1 & " Kopien mit der Produkt-Nr. " & Antw & " bis "
    strM = strM & ChargenNummer - 1 & " zum Drucker geschickt."
    MsgBox strM, vbInformation, TitelHV
 End If
  
  'Chargennummerierung für eine Verpackungsvorschrift in der Verpackung
  If VorschriftenTypVerpackung Then
    strM = "Bitte geben Sie die Chargennummer des aktuellen Auftrages ein" & vbCrLf & vbCrLf & "Beispiel: Chargenbeispiel Dr. Falk : Ch-Nr.: 13J23538P" & vbCrLf & vbCrLf & "ZJnnnn Beispiel: für den Produktionsauftrag A00021 bitte nur 00021 eintragen ohne das Kennzeichen A!"
    Antw = ProduktDefault
      While Not bFlag
        Antw = InputBox(strE & strM, TitelVV, Antw)
        If Antw = "" Then Exit Sub
        For i = 1 To Len(Antw)
        If Not Mid(Antw, i, 1) Like "[0-9]" Then
            strE = "Das ist keine gültige Zahl." & vbCr & vbCr
            bFlag = False: Exit For
        Else
            bFlag = True
        End If
        Next i
    Wend
    ChargenNummer = Val(Antw)
    For i = 1 To Kopien
        ChargenNummerFormatiert = Format(ChargenNummer, "00000")
        Charge = ChargenBuchstabe + ChargenNummerFormatiert + ChargenTyp
        NummerEinbringen Charge
        On Error Resume Next
        dlg.Execute
        rc = Err.Number
        On Error GoTo 0
        If rc > 0 Then
        strM = "Beim Drucken ist folgender Fehler aufgetreten:" & vbCr & vbCr
        strM = strM & "RC: (" & rc & ")" & vbCr & Error(rc)
        MsgBox strM, vbExclamation, TitelVV
        Exit Sub
        Else
        ChargenNummer = ChargenNummer + 1
        End If
    Next i
    strM = "Es wurden " & i - 1 & " Kopien mit der Produkt-Nr. " & Antw & " bis "
    strM = strM & ChargenNummer - 1 & " zum Drucker geschickt."
    MsgBox strM, vbInformation, TitelVV
  End If
  
  
End Sub

Private Function NummerHolen() As Integer
  Dim lNummer As String
  Q = Chr(34)
  On Error Resume Next
  Projekt = ActiveDocument.CustomDocumentProperties(Zeiger).Value
  If Projekt = "" Then
    strM = "Die Dokumenteigenschaft " & Q & Zeiger & Q & " ist nicht vorhanden "
    MsgBox strM, vbExclamation, TitelHV
    NummerHolen = -12
    Exit Function
  End If
  ChargenNummer = ActiveDocument.CustomDocumentProperties(Projekt).Value
  On Error GoTo 0
  If ChargenNummer = "" Then flag = True
  For i = 1 To Len(ChargenNummer)
    If Not Mid(i, 1) Like "[0-9]" Then flag = True: Exit For
  Next i
  If flag Then
    strM = "Die Dokumenteigenschaft " & Q & Projekt & Q & " oder deren Inhalt ist ungültig."
    MsgBox strM, vbExclamation, TitelHV
    NummerHolen = -8
    Exit Function
  End If
  NummerHolen = Val(ChargenNummer) + 1
End Function

Sub NummerEinbringen(lNummer As String)
  Dim oRange As Range
  lNummer = Format(lNummer, "00000")                                                                        'automatisch mit nullen auffüllen
  ActiveDocument.CustomDocumentProperties(Projekt).Value = lNummer
  For Each oRange In ActiveDocument.StoryRanges
    oRange.Fields.Update
    While Not (oRange.NextStoryRange Is Nothing)
      Set oRange = oRange.NextStoryRange
      oRange.Fields.Update
    Wend
  Next
End Sub