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
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
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"
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
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")
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