PrintOut
22.03.2006 16:29:01
Sebastian
vielleicht wisst ihr ja weiter.
Programm geschrieben, mehrere Register.
Per Knopfdruck automatisches erstellen einer Art Druckvorschau -> funktioniert.
Anderer Button, ähnlicher Code: Das einzelne Ausdrucke soll entfallen und ein kompletter Katalog erstellt werden, Bilder sind enthalten.
Nun ist das Makro wohl zu schnell, denn ich bekomme zwar einen katalog, aber nicht mit geänderten bildern, sondern mit dem startbild.
Wie kann ich das abwarten, bis das neue bild geladen ist, und der dann erst ausdruckt.
Code:
Sub Katalog_Oberfl_extern_Click()
Modul1.Rowindex_O = 8
Modul1.Fertig = 0
Modul1.Printpossible = False
Application.Dialogs(xlDialogPrinterSetup).Show
Antw = MsgBox("Aktiver Drucker " & Application.ActivePrinter, vbOKCancel)
If Antw = vbCancel Then Exit Sub
Anfang:
Tabelle14.Nächstes_ext_Click
If Modul1.Printpossible = True Then
Worksheets("DruckvorschauO_extern").Image1.Picture
Antw2 = MsgBox("Test", vbOKOnly)
'Worksheets("DruckvorschauO_extern").PrintOut
Modul1.Printpossible = False
End If
If Modul1.Fertig = 0 Then GoTo Anfang
End Sub
Sub Nächstes_ext_Click()
NextZeile:
zeilennummer = Modul1.Rowindex_O
zeilennummer = zeilennummer + 1
If zeilennummer > 8 Then
If Worksheets("Oberflächenfehler").Cells(zeilennummer, 1).Value <> "" Then
If Worksheets("Oberflächenfehler").Cells(zeilennummer, 1).EntireRow.Hidden = True Then
Modul1.Rowindex_O = zeilennummer
GoTo NextZeile 'Rücksprung zum Beginn der Sub
End If
Worksheets("DruckvorschauO_extern").Activate
picPath = Worksheets("Oberflächenfehler").Cells(zeilennummer, 31).Value
Worksheets("DruckvorschauO_extern").Cells(7, 2) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 1).Value
Worksheets("DruckvorschauO_extern").Cells(7, 8) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 4).Value
Worksheets("DruckvorschauO_extern").Cells(7, 18) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 5).Value
Worksheets("DruckvorschauO_extern").Cells(13, 3) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 8).Value
Worksheets("DruckvorschauO_extern").Cells(13, 8) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 9).Value
Worksheets("DruckvorschauO_extern").Cells(13, 13) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 10).Value
Worksheets("DruckvorschauO_extern").Cells(13, 20) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 11).Value
Worksheets("DruckvorschauO_extern").Cells(13, 27) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 12).Value
Worksheets("DruckvorschauO_extern").Cells(10, 3) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 13).Value
Worksheets("DruckvorschauO_extern").Cells(10, 8) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 14).Value
Dim Prio
Prio = Worksheets("Oberflächenfehler").Cells(zeilennummer, 15).Value
Select Case Prio
Case 1
Worksheets("DruckvorschauO_extern").Cells(10, 16) = "schwach"
Case 2
Worksheets("DruckvorschauO_extern").Cells(10, 16) = "mittel"
Case 3
Worksheets("DruckvorschauO_extern").Cells(10, 16) = "stark"
Case Else
Worksheets("DruckvorschauO_extern").Cells(10, 16) = ""
End Select
Worksheets("DruckvorschauO_extern").Cells(10, 23) = Worksheets("Oberflächenfehler").Cells(zeilennummer, 16).Value
Dim Messaufnahme
Messaufnahme = Worksheets("Oberflächenfehler").Cells(zeilennummer, 27).Value
Select Case Messaufnahme
Case 1
Worksheets("DruckvorschauO_extern").Cells(7, 24) = "Messaufnahme"
Case 2
Worksheets("DruckvorschauO_extern").Cells(7, 24) = "Abziehvorrichtung"
Case 3
Worksheets("DruckvorschauO_extern").Cells(7, 24) = "Messaufnahme & Abziehvorrichtung"
Case 4
Worksheets("DruckvorschauO_extern").Cells(7, 24) = "Andere Aufnahmeart"
Case Else
Worksheets("DruckvorschauO_extern").Cells(7, 24) = ""
End Select
Modul1.Rowindex_O = zeilennummer
If picPath = "" Then
Dim Mldg, Stil, Titel
Mldg = "Kein Bild verfügbar"
Stil = vbokbutton
Titel = "Fehler"
Antwort = MsgBox(Mldg, Stil, Titel)
Worksheets("DruckvorschauO_extern").Image1.Visible = False
Else
Path = Modul1.Pfad & "\" & picPath
Worksheets("DruckvorschauO_extern").Image1.Visible = True
On Error Resume Next
Worksheets("DruckvorschauO_extern").Image1.Picture = LoadPicture(Path)
Modul1.Printpossible = True
If Err.Number <> 0 Then
Worksheets("DruckvorschauO_extern").Image1.Visible = False
Mldg = "Fehler " & Str(Err.Number) & Chr(13) & "Meldung: " & Err.Description
MsgBox Mldg, , "Fehler", Err.HelpFile, Err.HelpContext
Modul1.Printpossible = False
End If
End If
Else
Dim Mldg2, Stil2, Titel2
Mldg2 = "Keine weiteren Teile"
Stil2 = vbokbutton
Titel2 = "Fehler"
Antwort2 = MsgBox(Mldg2, Stil2, Titel2)
Modul1.Printpossible = False
Modul1.Fertig = 1
End If
End If
End Sub