Progressbar während Druckauftrag
14.04.2016 16:45:25
Nina
Mit folgendem Makro, wird die "Wochenauswertung" für unsere Abteilung gedruckt und anschließend zurückgesetzt. Da ich für alle 13 Arbeitsblätter einzelne Druckaufträge schicken muss (da die Tabellenblätter oft aus mehreren Seiten bestehen, ich aber nur immer die erste Seite drucken möchte) und diese auch an einen Netzwerkdrucker geschickt werden, bei dem der Mitarbeiter für den Ausdruck seinen Ausweis auflegen muss, benötigt das Makro von Anfang bis Ende ca. 1-2 Minuten, abhängig vom jeweiligen PC. Damit die künftigen User meiner Arbeitsmappe wissen, dass der Rechner "arbeitet", hätte ich für folgendes Makro gerne einen Progressbar:
Sub Drucken()
Z = MsgBox("WOCHENAUSWERTUNG jetzt drucken?", vbYesNo, "Bestätigung")
If Z = vbYes Then
MsgBox "Druckauftrag wird jetzt gesendet (Dauer: ca. 1 Minute)"
Application.ScreenUpdating = False
- - - HIER MÜSSTE DER PROGRESSBAR EINGEFÜGT WERDEN, HABE SCHON ETWAS VORGEARBEITET:
PROgress.Show vbModeless
Dim i As Long
With PROgress
.ProgressBar1.Max = 10
.ProgressBar1.Min = 0
For i = Sheets(1).PrintOut To Sheets(13).PrintOut
.ProgressBar1 = i
Next i
Dim Drucker$, DDrucker$
'Druckeranschluss ermitteln
On Error Resume Next
Drucker = Application.ActivePrinter
For d = 0 To 20
Err = 0
Application.ActivePrinter = "\\SW020910.europe.corp\secure auf Ne" & Format(d, " _
00") & ":"
If Err = 0 Then
DDrucker = "\\SW020910.europe.corp\secure auf Ne" & Format(d, "00") & ": _
Exit For
End If
Next
On Error GoTo 0
Worksheets(2).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(3).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(4).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(5).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(6).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(7).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(8).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(9).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(10).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(11).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(12).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
Worksheets(13).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoTrue
'Arbeitsblätter wählen
Sheets(1).PrintOut from:=1, To:=1
Sheets(2).PrintOut from:=1, To:=1
Sheets(3).PrintOut from:=1, To:=1
Sheets(4).PrintOut from:=1, To:=1
Sheets(5).PrintOut from:=1, To:=1
Sheets(6).PrintOut from:=1, To:=1
Sheets(7).PrintOut from:=1, To:=1
Sheets(8).PrintOut from:=1, To:=1
Sheets(9).PrintOut from:=1, To:=1
Sheets(10).PrintOut from:=1, To:=1
Sheets(11).PrintOut from:=1, To:=1
Sheets(12).PrintOut from:=1, To:=1
Sheets(13).PrintOut from:=1, To:=1
Worksheets(2).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(3).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(4).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(5).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(6).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(7).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(8).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(9).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(10).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(11).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(12).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(13).Select
ActiveSheet.Shapes.Range(Array("SF")).Visible = msoFalse
Worksheets(2).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(3).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(4).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(5).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(6).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(7).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(8).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(9).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(10).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(11).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(12).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(13).Select
Range("J7:O12,J14:O23").Select
Range("J14").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("b3").Select
Worksheets(14).Shapes.Range(Array("H1")).Visible = msoFalse
Worksheets(14).Shapes.Range(Array("H2")).Visible = msoFalse
Worksheets(14).Shapes.Range(Array("H3")).Visible = msoFalse
Worksheets(14).Shapes.Range(Array("H4")).Visible = msoFalse
Worksheets(14).Shapes.Range(Array("H5")).Visible = msoFalse
Worksheets(14).Shapes.Range(Array("H6")).Visible = msoFalse
Worksheets(14).Shapes.Range(Array("H7")).Visible = msoFalse
Worksheets(2).Select
Range("u28").Select
- - - HIER MÜSSTE SICH DER PROGRESSBAR WIEDER SCHLIEßEN
End With
Application.ScreenUpdating = True
MsgBox "Lege nun deinen Mitarbeiterausweis auf den nächsten Farbdrucker, warte bis deine _
Auswertung gedruckt wurde und hänge diese an deiner Tafel aus"
End If
End Sub