1 1 1 1 1 1 1 1 1 1 Rating 5.00 (1 Vote)

Problemstellung:
Wenn man Etiketten drucken will steht man oft vor einigen Problemen.
1. Man möchte nur ein paar Etiketten drucken und beim nächsten Druck braucht man wieder
   ein neues Blatt weil freie Etiketten z.B. erst ab 7. Postition vorhanden sind.

2. Man möchte von einer gleichen Adresse mehrere Etiketten drucken.

Für diese beiden Probleme möchte ich hier eine Lösung vorstellen.

Voraussetzungen:
Das Bsp ist ab A2002 lauffähig. (Download enthält eine mdb-Datei für A2002/A2003 und eine accdb ab A2007)

Lösung:
Als Bsp. habe ich die Kundentabelle aus der "Nordwind-DB" von MS genommen.
Die Download DB kann aber nach eigenem Ermessen angepasst werden.

Die Datenbank benötigt für die Lösung eine zusätzliche Tabelle (hier im Bsp. "tbl_KundenTmp").
Diese kann sich auch in einer anderen DB befinden und als Verknüpfung eingebunden werden.
Wichtig ist nur das diese Tabelle die gleichen Felder enthält die in der Adresstabelle vorhanden sind
bzw. für den Etikettendruck benötigt werden.

Achtung: die Felder in der "tbl_KundenTmp" dürfen nicht indiziert sein und müssen leere Zeichenfolgen zulassen.

Um das Bsp. in Eurer DB zu verwenden müsst Ihr als erstes einen Etikettenbericht mit Euren Etikettenmaßen erstellen.
In meinem Bsp. ist das Etikett mit einem Rechteck mit Rahmen hinterlegt. Dieser dient nur zu Layoutzwecken für dieses Bsp. und ist nicht erforderlich.

Kommen wir nun zum 1. Teil in dem wir den Etikettendruck an einer bestimmten Position beginnen lassen wollen.

Im Formular sehen wir die Adressliste in einem Endlosform.
Links befindet sich eine Checkbox mit der man die zu druckenden Datensätze markieren kann (gelb).
Um alle Datensätze aus- bzw. abzuwählen kann man die beiden Buttons oben benutzen (grün).
Soll der Druck an der 1. Position beginnen kann jetzt einfach der Button "Drucken" geklickt werden.

Wurde kein Datensatz markiert kommt ein Warnhinweis und der Vorgang wird abgebrochen

Jetzt kann in dem Kombifeld die Startposition des ersten zu druckenden Etiketts festgelegt werden (orange).
Hier ein Bsp: es wurden 4 Adressen markiert und der Druck soll ab der Position 4 beginnen.

Ergebnis der Druckvorschau:

Der Code ist nicht kompliziert:

Private Sub cmd_Print2_Click()
    Dim iMark As Integer, i As Integer, j As Integer, k As Integer
    Dim rs As DAO.Recordset, rsIn As DAO.Recordset, rsOut As DAO.Recordset

    'Temp Tabelle leeren
    CurrentDb.Execute "DELETE tbl_KundenTmp.* FROM tbl_KundenTmp;"

    'Prüfen ob min. ein Datensatz ausgewählt wurde
    iMark = fcDomWert("Firma", "tbl_Kunden", "[Print]=-1", ltDCount)

    'Wenn kein Datensatz ausgewält wurde ist hier Schluss
    If iMark = 0 Then
        MsgBox "Keinen Datensatz gewählt!", vbCritical + vbOKOnly, "Fehler"
        Exit Sub
    End If

    'Ist Startpostion=1 dann wird der normale Etikettenbericht angezeigt
    If Me.cbo_Start1 = 1 Then
        'Anzahl der zu druckenden Etiketten erzeugen
        Set rsIn = CurrentDb.OpenRecordset("qry_Adressen")
        Set rsOut = CurrentDb.OpenRecordset("tbl_KundenTmp")
        Do While Not rsIn.EOF
            'Anzahl der gewählten Datensätze durchlaufen
            For j = 1 To Me.cbo_Anzahl
                rsOut.AddNew
                'Inhalt der Adressfelder in Temp Tabelle schreiben
                For k = 0 To 6
                    rsOut.Fields(k) = rsIn.Fields(k)
                Next k
                rsOut.Update
            Next j
            rsIn.MoveNext
        Loop
        rsIn.Close
        rsOut.Close
        DoCmd.OpenReport "rpt_Etikett_Start2", acViewPreview
    Else
        'Anzahl der Dummy Datensätze erzeugen für Startpostion
        Set rs = CurrentDb.OpenRecordset("tbl_KundenTmp")
        For i = 1 To Me.cbo_Start1 - 1
            rs.AddNew
            rs!Print = -1
            rs.Update
        Next i
        rs.Close
        'Anzahl der zu druckenden Etiketten erzeugen
        Set rsIn = CurrentDb.OpenRecordset("qry_Adressen")
        Set rsOut = CurrentDb.OpenRecordset("tbl_KundenTmp")
        Do While Not rsIn.EOF
            'Anzahl der gewählten Datensätze durchlaufen
            For j = 1 To Me.cbo_Anzahl
                rsOut.AddNew
                'Inhalt der Adressfelder in Temp Tabelle schreiben
                For k = 0 To 6
                    rsOut.Fields(k) = rsIn.Fields(k)
                Next k
                rsOut.Update
            Next j
            rsIn.MoveNext
        Loop
        rsIn.Close
        rsOut.Close
        DoCmd.OpenReport "rpt_Etikett_Start2", acViewPreview
    End If
End Sub

Zuerst wird die Tabelle mit den temporären Datensätzen geleert. Dann wird geprüft ob min. ein Datensatz markiert wurde.
Ist die Startposition=1 dann wird der Bericht normal geöffnet ansonsten wird ein Anzahl (Startpostition -1) Dummy Datensätzen erstellt.
Diese Daten werden dann in Unionabfrage "qry_Output" aus der Adress- und Temptabelle zusammen gefügt

SELECT tbl_KundenTmp.Firma,
       tbl_KundenTmp.Kontaktperson,
       tbl_KundenTmp.Strasse,
       tbl_KundenTmp.PLZ,
       tbl_KundenTmp.Ort,
       tbl_KundenTmp.Print
FROM tbl_KundenTmp
WHERE (((tbl_KundenTmp.Print)=-1))
ORDER BY tbl_KundenTmp.Firma,
         tbl_KundenTmp.Kontaktperson
UNION ALL
SELECT tbl_Kunden.Firma,
       tbl_Kunden.Kontaktperson,
       tbl_Kunden.Strasse,
       tbl_Kunden.PLZ,
       tbl_Kunden.Ort,
       tbl_Kunden.Print
FROM tbl_Kunden
WHERE (((tbl_Kunden.Print)=-1));

Im 2. Teil soll das Ziel sein von einer oder mehreren Adressen mehrere Etiketten mit der gleichen Adresse zu drucken

Auch soll hier die Startposition festgelegt werden können.

 

In diesem Fall nehme ich ein Einzelformular. Dort können dann die zu druckenden Adressen markiert werden (gelb).
Auch kann hier wieder die Startposition gesetzt werden (grün).
Und die Anzahl der Etiketten die von der jeweiligen Adresse gedruckt werden sollen (orange).

Ergebnis der Druckvorschau bei Startpostion=3, Anzahl der Etiketten=5, gewählt ein Datensatz:

Hier wurde der Code dahin erweitert das von den markierten Adressen die gewählte Anzahl in der Temptabelle kopiert werden.

Private Sub cmd_Print2_Click()
    Dim iMark As Integer, i As Integer, j As Integer, k As Integer
    Dim rs As DAO.Recordset, rsIn As DAO.Recordset, rsOut As DAO.Recordset

    'Temp Tabelle leeren
    CurrentDb.Execute "DELETE tbl_KundenTmp.* FROM tbl_KundenTmp;"

    'Prüfen ob min. ein Datensatz ausgewählt wurde
    iMark = fcDomWert("Firma", "tbl_Kunden", "[Print]=-1", ltDCount)

    'Wenn kein Datensatz ausgewält wurde ist hier Schluss
    If iMark = 0 Then
        MsgBox "Keinen Datensatz gewählt!", vbCritical + vbOKOnly, "Fehler"
        Exit Sub
    End If

    'Ist Startpostion=1 dann wird der normale Etikettenbericht angezeigt
    If Me.cbo_Start1 = 1 Then
        'Anzahl der zu druckenden Etiketten erzeugen
        Set rsIn = CurrentDb.OpenRecordset("qry_Adressen")
        Set rsOut = CurrentDb.OpenRecordset("tbl_KundenTmp")
        Do While Not rsIn.EOF
            'Anzahl der gewählten Datensätze durchlaufen
            For j = 1 To Me.cbo_Anzahl
                rsOut.AddNew
                'Inhalt der Adressfelder in Temp Tabelle schreiben
                For k = 0 To 6
                    rsOut.Fields(k) = rsIn.Fields(k)
                Next k
                rsOut.Update
            Next j
            rsIn.MoveNext
        Loop
        rsIn.Close
        rsOut.Close
        DoCmd.OpenReport "rpt_Etikett_Start2", acViewPreview
    Else
        'Anzahl der Dummy Datensätze erzeugen für Startpostion
        Set rs = CurrentDb.OpenRecordset("tbl_KundenTmp")
        For i = 1 To Me.cbo_Start1 - 1
            rs.AddNew
            rs!Print = -1
            rs.Update
        Next i
        rs.Close
        'Anzahl der zu druckenden Etiketten erzeugen
        Set rsIn = CurrentDb.OpenRecordset("qry_Adressen")
        Set rsOut = CurrentDb.OpenRecordset("tbl_KundenTmp")
        Do While Not rsIn.EOF
            'Anzahl der gewählten Datensätze durchlaufen
            For j = 1 To Me.cbo_Anzahl
                rsOut.AddNew
                'Inhalt der Adressfelder in Temp Tabelle schreiben
                For k = 0 To 6
                    rsOut.Fields(k) = rsIn.Fields(k)
                Next k
                rsOut.Update
            Next j
            rsIn.MoveNext
        Loop
        rsIn.Close
        rsOut.Close
        DoCmd.OpenReport "rpt_Etikett_Start2", acViewPreview
    End If
End Sub

Ich hoffe es hilft Diesem oder Jenem weiter.

Dateien:
(3 Stimmen)

Datum 05.02.2018
Dateigröße 40.48 KB
Download 881

(0 Stimmen)
Datum 05.02.2018
Dateigröße 48.16 KB
Download 616

Ähnliche Artikel

You have no rights to post comments

Login Form

Neueste Artikel

SQL zu VBA Konverter
26. Oktober 2018
Problemstellung: Nur für 32Bit Office Versionen Gibt es eine Möglichkeit SQL-Code einer Abfrage so zu konvertieren das der Code in VBA genutzt werden kann? Lösung: Bis Access 2010 gibt das Tool...
1.png5.png7.png9.png4.png4.png4.png
Heute476
Gestern486
Diese Woche1793
Dieser Monat8067
Total1579444

  • IP: 3.95.231.212
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

3
Online

29. März 2024

Letzte Kommentare

  • Berechnen von Zeiträumen als Abfragekriterium

    elmard 02.02.2021 21:02
    1000 Dank
    für diese Datenbankanwendung! Eine sehr gute Umsetzung mit den vielen Möglichkeiten des Datums.

    Weiterlesen...

     
  • SQL zu VBA Konverter

    Tommy Admin 03.11.2019 16:33
    RE: SQL zu VBA Konverter
    Hallo Elmard, danke für die Info. :lol:

    Weiterlesen...

     
  • SQL zu VBA Konverter

    elmard 03.11.2019 14:49
    Bei SmartTools neue Version 4.0
    Dieses Tool liegt inzwischen in der Version 4 vor und läuft nun auch von A2013 und A2016 sowie im ...

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    TommyK 27.02.2019 06:52
    Workshop
    Hallo mpegjunkie, danke für Dein Feedback. Schön das Dir Workshop weiter hilft. :D

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    mpegjunkie 26.02.2019 20:10
    Perfekter Workshop
    Hallo Tommy, perfekter Workshop, toll und umfassend erläutert. Jetzt nutze ich diese Controls auch.

    Weiterlesen...