Hallo,
ich zitiere hier mal nicht noch alles bisher Geschriebene, also hier ein
bisschen Coding, manches ist aus dem Internet kopiert und modifiziert,
so siehts auch aus ;-). Ich hoffe man verstehts trotzdem ein bisschen.
Es soll sich um CD-Etiketten handeln, mit einem kleinen Icon drauf. Ok,
auf gehts:
Zunächst der VB-Code des Berichts selber und unten dann die Subs, die
daraus aufgerufen werden. Das zeitigt die in meinem letzten Posting
beschriebenen Effekte. Ich habs grade nochmal versucht... Was natürlich
beim Drucken (aus dem Kontextmenü) wieder pro etikett durchlaufen wird,
ist natürlich "Detailbereich_Format", sehe ich ein. Aber nicht, dass
dann eine leere Seite (wenn ichs in ein PDF-File drucke) bzw. ein Nichts
(wenn ichs direkt an den Drucker schicke) dabei rauskommt. Also viel
Spass beim lesen des Codings.
Volker
------------------------------------------
Private Sub Detailbereich_Format(Cancel As Integer, FormatCount As Integer)
On Error GoTo Detailbereich_Format_Err
Dim db As Database
Dim sgenre As Recordset
Call Etikett_Layout(Me)
Set db = CurrentDb()
Set sgenre = db.OpenRecordset("Genres", dbOpenTable)
With sgenre
' Index festlegen.
.Index = "Genre"
.Seek "=", Genre
If .NoMatch = False Then
Logo_Genre.Picture = sgenre("Logo")
If Not IsNull(sgenre("Farbe")) Then
Label.BackColor = sgenre("Farbe")
Else
Label.BackColor = -2147483633
End If
' Dunkle Farben mit hellem Text
If (sgenre("Genre") = "Comedy" Or sgenre("Genre") = "Kinder" Or
sgenre("Genre") = "Nature") Then
Genre.ForeColor = 15000804
Nummer.ForeColor = 15000804
Index.ForeColor = 15000804
Else
Genre.ForeColor = 0
Nummer.ForeColor = 0
Index.ForeColor = 0
End If
Else
Logo_Genre.Picture = "E:\Access\Volker\Musik & Videos\Logos\kein
Bild.jpg"
Label.BackColor = -2147483633
Genre.ForeColor = 0
Nummer.ForeColor = 0
Index.ForeColor = 0
End If
End With
Detailbereich_Format_Exit:
Exit Sub
Detailbereich_Format_Err:
MsgBox Error$
Resume Detailbereich_Format_Exit
End Sub
------------------------------------------
Private Sub Report_Close()
caller_etikett = ""
End Sub
------------------------------------------
Private Sub Report_Open(Cancel As Integer)
Call Etikett_Setup
If abbruch_etikett = True Then
Cancel = True
End If
End Sub
------------------------------------------
Function Etikett_Layout(MyRpt As Report)
Dim db As Database
Dim myrec As Recordset
Set db = CurrentDb()
Set myrec = db.OpenRecordset("Kopfdaten Medien", dbOpenTable)
' wenn die aktuelle Leere Anzahl noch kleiner als die der angegebenen
Leeren
' und wir uns auf Seite 1 befinden
If LeerAnzahl& < LeerEtiketten& And MyRpt.Page = 1 Then
' nicht auf den nächsten Datensatz gehen und auch nicht ausgeben
MyRpt.NextRecord = False
MyRpt.PrintSection = False
LeerAnzahl& = LeerAnzahl& + 1
Else
If zaehler& < start& Then
MyRpt.MoveLayout = False
MyRpt.PrintSection = False
MyRpt.NextRecord = True
zaehler& = zaehler& + 1
Exit Function
End If
If zaehler& > ende& Then
MyRpt.MoveLayout = False
MyRpt.PrintSection = False
MyRpt.NextRecord = True
zaehler& = zaehler& + 1
Exit Function
End If
' sooo, die x Positionen sind übersprungen
' wenn aktuelle anzahl der Kopien < als die angegebene Kopienanzahl
If KopieAnzahl& < (KopienEtiketten& - 1) Then
' nicht auf den nächsten Datensatz, aber ausgeben und die
Anzahl der ausgegebenen
' Kopien erhöhen
MyRpt.NextRecord = False
KopieAnzahl& = KopieAnzahl& + 1
Else
' auf den nächsten Datensatz, die Anzahl der Kopien wieder
zurücksetzen, ausgeben,
KopieAnzahl& = 0
zaehler& = zaehler& + 1
If zaehler& > myrec.RecordCount Then
Exit Function
End If
End If
End If
End Function
------------------------------------------
Function Etikett_Setup()
Dim db As Database
Dim myrec As Recordset
Dim eingabe As String
zaehler& = 0
LeerAnzahl& = 0
KopieAnzahl& = 0
abbruch_etikett = False
If daten_uebernehmen = True Then
Exit Function
End If
If caller_etikett = "MENU" Then
If einzeldruck = True Then
einzeldruck = False
Exit Function
End If
einzeldruck = False
Set db = CurrentDb()
Set myrec = db.OpenRecordset("Kopfdaten Medien", dbOpenTable)
eingabe = InputBox$("Anzahl der Kopien je Etikett", , 1)
If Not eingabe = "" Then
KopienEtiketten& = Val(eingabe)
Else
abbruch_etikett = True
Exit Function
End If
eingabe = InputBox$("Zu überspringende Etiketten (< 76)", , 0)
If Not eingabe = "" Then
LeerEtiketten& = Val(eingabe)
Else
abbruch_etikett = True
Exit Function
End If
DoCmd.OpenForm "Etikett Eingabe Start Ende", acNormal, , , ,
acDialog
If LeerEtiketten& < 0 Then LeerEtiketten& = 0
If LeerEtiketten& > 75 Then LeerEtiketten& = 75
If KopienEtiketten& < 1 Then KopienEtiketten& = 1
If start& < 1 Then start& = 0
If ende& > myrec.RecordCount Then ende& = myrec.RecordCount
If start& > ende& Then start& = ende&
Else
MsgBox "Die Etikettenvorschau bzw. der Etikettendruck darf nur aus
dem Menü gestartet werden!", vbExclamation
abbruch_etikett = True
End If
End Function
------------------------------------------
Sub vorschau_etikett()
On Error GoTo vorschau_Err
caller_etikett = "MENU"
DoCmd.OpenReport "Etiketten Kopfdaten Medien", acViewPreview
vorschau_Exit:
Exit Sub
vorschau_Err:
MsgBox "Vorschau abgebrochen", vbExclamation
caller_etikett = ""
Resume vorschau_Exit
End Sub
------------------------------------------
Sub druck_etikett()
On Error GoTo druck_Err
' Just to be sure:
If caller_etikett = "MENU" Then
DoCmd.Close acReport, "Etiketten Kopfdaten Medien"
daten_uebernehmen = True
End If
caller_etikett = "MENU"
' Jetzt fehlt mir hier nur noch die Drucker-Auswahl
DoCmd.OpenReport "Etiketten Kopfdaten Medien", acNormal
daten_uebernehmen = False
druck_Exit:
Exit Sub
druck_Err:
MsgBox "Druck abgebrochen", vbExclamation
caller_etikett = ""
Resume druck_Exit
End Sub
------------------------------------------