Function DruckEtikett()
' Deklarierung der notwendigen Variablen Teil I
Dim I As Integer, Start
' Öffnet das Formular zur Auswahl, welches Etikett zu bedrucken ist.
DoCmd.OpenForm "Auswahl zu bedruckendes Etikett", A_NORMAL, , , , A_DIALOG
If IstGeladen("Auswahl zu bedruckendes Etikett") Then
Start = Forms![Auswahl zu bedruckendes Etikett]!OptionGewünschtesEtikett
Else
Exit Function
End If
Start = CDbl(Start)
I = 1
'Fehlerbehandlungsroutine einschalten
On Error GoTo EtikettSpezial_Err
' Deklarierung der notwendigen Variablen Teil II
Dim dy As adodb.Recordset
' Warnmeldungen ausschalten
DoCmd.SetWarnings False
' Löschen der Tabelle Etikett, um ein leere Tabelle zu erhalten
DoCmd.RunSQL "Delete from Etikett;"
' Variablen initialisieren
Set dy = new adodb.Recordset
dy.open "select * from Etikett", currentproject.connection
' Beginn der Transaktion
' BeginTrans
' Schreiben von leeren Datensätzen für die nicht benötigten Etiketten
Do Until I = Start
dy.AddNew
dy.Update
I = I + 1
Loop
' Schreiben des zu bedruckenden Etikettes in die Tabelle
dy.AddNew
dy![Firma 1] = Forms.[Etikett Spezial]![Firma 1]
dy![Firma 2] = Forms.[Etikett Spezial]![Firma 2]
dy![Abteilung] = Forms.[Etikett Spezial]![Abteilung]
Select Case Forms.[Etikett Spezial]![Geschlecht]
Case "Firma"
dy![Geschlecht] = ""
Case "Frau"
dy![Geschlecht] = "z. Hd. Frau"
Case "Herr"
dy![Geschlecht] = "z. Hd. Herrn"
End Select
dy![Titel] = Forms.[Etikett Spezial]![Titel]
dy![Vorname] = Forms.[Etikett Spezial]![Vorname]
dy![Nachname] = Forms.[Etikett Spezial]![Nachname]
dy![Straße] = Forms.[Etikett Spezial]![Straße]
dy![Land] = UCase(Forms.[Etikett Spezial]![Land]) & "-"
dy![Plz] = Forms.[Etikett Spezial]![Plz]
dy![Stadt] = Forms.[Etikett Spezial]![Stadt]
dy.Update
' CommitTrans
' Schließen der Dynaset-Variablen
dy.Close
' Schließen der an der Auswahl beteiligten Formulare
DoCmd.Close A_FORM, "Etikett Spezial"
DoCmd.Close A_FORM, "Auswahl zu bedruckendes Etikett"
' Aufruf des Berichtes, um das Etikett zu bedrucken
DoCmd.OpenReport "Etikett", A_PREVIEW
EtikettSpezial_Exit:
Exit Function
EtikettSpezial_Err:
StdErrProc
Resume EtikettSpezial_Exit
End Function
|