Word 2003 Vorlage mit Druckzähler ausstatten

Lösung: Sie können dies mit einer VBA-Lösung erledigen. Beachten Sie Folgendes. Wenn der Zähler immer wieder bei 1 anfangen soll, dann verwenden Sie eine Vorlage (*.dot), soll der Zähler sich die Gesamtzahl der Ausdrucke merken, dann verwenden Sie ein normales Dokument (*.doc).

Öffnen Sie das entsprechende Dokument und wählen Sie dann im Menü Datei/Eigenschaften. Wechseln Sie zur Registerkarte Anpassen. Hier erfassen Sie nun zwei neue Dokumenteneigenschaften. Tragen sie im Feld «Name» den Begriff «@Nummer» ein und im Feld «Wert» vergeben Sie einen aussagekräftigen Namen für diese Dokumenteneigenschaft, z.B. «Druckexemplar». Als zweite Eigenschaft tragen Sie nun in «Name» den eben vergebenen Namen ein, also «Druckexemplar». Den Feldtyp ändern Sie auf «Zahl» und als Wert tragen Sie diesmal «0» ein.

Verlassen Sie den Eigenschaften-Dialog und positionieren Sie den Cursor an jener Stelle im Dokument, an der die Druckexemplar-Nummer erscheinen soll.

Drücken Sie die Tastenkombination Ctrl+F9 um ein leeres Paar geschweifter Kammern einzufügen. Schreiben Sie in dieses Klammernpaar DocProperty Druckexemplar (bei Versionen vor Word 2000 muss DokEigenschaft statt DocProperty verwendet werden)

Drücken Sie Alt+F9 um die Feldfunktionen auszublenden und dann nochmal F9 um den Feldinhalt zu aktualisieren. Es sollte jetzt eine «0» angezeigt werden.

So, nun brauchen Sie noch das Makro. Öffnen Sie mit Alt+F11 den VBA-Editor. Fügen Sie über das Menü Einfügen/Modul ein neues leeres Modul ein. Kopieren Sie dann den untenstehenden Code und fügen Sie ihn in das leere Codefenster ein.

Um zu drucken, rufen Sie über Alt+F8 das Makro «Druckexemplar» auf. Sie können das Makro auch einer Schaltfläche zuweisen. Es wird der Druckdialog aufgerufen, bei welchem Sie die Anzahl Drucke eingeben

Danach wird ein Dialog angezeigt, in welchem Sie bei Bedarf eine andere Startnummer eingeben können

Wenn Sie auf OK klicken, erscheint eine Meldung, welche Nummern gerade ausgedruckt werden.

Drücken Sie nochmals auf OK, um den Druck zu starten. Die Nummer im Dokument selber bleibt auf dem letzten Stand stehen (wenn Sie das Dokument speichern).

---------------------------------------------
MAKRO ZUM KOPIEREN:
---------------------------------------------

Private Const Titel = "Drucken mit Laufnummer"
Private Const Zeiger = "@Nummer"
Private Projekt As String
Sub Druckexemplar()
Dim dlg As Dialog, Nummer As Long
Set dlg = Dialogs(wdDialogFilePrint)
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 = "Die aktuelle Laufnummer für das Projekt " & Chr(34) & Projekt & Chr(34) & " ist "
strM = strM & Antw & "." & vbCr & "Mit welcher Nummer soll der Druck beginnen?"
While Not bFlag
Antw = InputBox(strE & strM, Titel, 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
Nummer = Val(Antw)
For i = 1 To Kopien
NummerEinbringen Nummer
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, Titel
Exit Sub
Else
Nummer = Nummer + 1
End If
Next i
strM = "Es wurden " & i - 1 & " Kopien mit den Laufnummern " & Antw & " bis "
strM = strM & Nummer - 1 & " zum Drucker geschickt."
MsgBox strM, vbInformation, Titel
End Sub

Private Function NummerHolen() As Integer
Dim lNummer As Long
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, Titel
NummerHolen = -12
Exit Function
End If
Nummer = ActiveDocument.CustomDocumentProperties(Projekt).Value
On Error GoTo 0
If Nummer = "" Then flag = True
For i = 1 To Len(Nummer)
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, Titel
NummerHolen = -8
Exit Function
End If
NummerHolen = Val(Nummer) + 1
End Function

Sub NummerEinbringen(lNummer As Long)
Dim oRange As Range
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

---------------------------------------------