Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1488to1492
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Progressbar während Druckauftrag

Progressbar während Druckauftrag
14.04.2016 16:45:25
Nina
Hallo ihr Profis!
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Progressbar während Druckauftrag
17.04.2016 03:04:37
fcs
Hallo Nina,
ich hab mal eine Userform mit Progressbar in eine Beispiel-Datei eingebaut.
https://www.herber.de/bbs/user/105017.xlsm
Dein Makro mit den erforderlichen Ergänzungen ist in einem separaten Modul.
Ich hab für die Abarbeitung der Blätter in deiner Datei mehrere For-Next-Shleifen eingebaut. Das ist effektiver als für jedes Blatt separate Anweisungen zu schreiben.
Gruß
Franz
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige