Drucken auf Knopfdruck

Forumthread: Drucken auf Knopfdruck

23.11.2016 18:55:54

Guten Abend zusammen,
ich würde gern über einen Makro/Schaltfläche alle meine Tabellenblätter drucken lassen. Aber leider stimmt etwas mit meinem Code nicht, da er zum einen die Seiten einzeln druckt, beispielsweise wenn man ein PDF erstellen möchte. Zum anderen wird, obwohl ich auf abbrechen drücke, trotzdem gedruckt...
Anbei mein Code:

Sub Drucken()
Application.ScreenUpdating = False
Dim ArrDruck() As String
Dim i As Integer
ArrDruck = Split("InhaltsV,Vorbemerkung,Geometrie,Eingabe,Standsicherheit,Laengsbew, _
Querkraftbew,Verankerung,Darstellung", ",")
Sheets(ArrDruck(0)).Select
Application.Dialogs(xlDialogPrint).Show
For i = 1 To UBound(ArrDruck)
ThisWorkbook.Sheets(ArrDruck(i)).PrintOut
Next
Application.ScreenUpdating = True
End Sub

Ich denke es hat was mit dem Befehl "Split" zu tun. Leider sind meine Programmierfähigkeiten begrenzt und hoffe daher auf eure Hilfe.
Danke schon mal.

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Drucken auf Knopfdruck

23.11.2016 20:07:53

fcs
AW: Drucken auf Knopfdruck

24.11.2016 09:36:15

Al
AW: Drucken auf Knopfdruck

24.11.2016 11:04:02

Al
@fsc AW: Drucken auf Knopfdruck

24.11.2016 13:52:05

Al
@fsc AW: Drucken auf Knopfdruck

24.11.2016 23:42:50

fcs
@fsc AW: Drucken auf Knopfdruck

25.11.2016 08:14:37

Al

AW: Drucken auf Knopfdruck

23.11.2016 20:07:53

fcs

Hallo Al,
Esist nicht die Funktion Split, die funktioniert soweit.
Es ist die Abarbeitung nach der Auswahl im Druckdialog.
Mit nachfolgenden Anpasssungen/Varianten kannst du mehrere/alle Sheets drucken.
Gruß
Franz

Sub Drucken()
Application.ScreenUpdating = False
Dim ArrDruck As Variant
ArrDruck = Split("InhaltsV,Vorbemerkung,Geometrie,Eingabe,Standsicherheit," _
& "Laengsbew,Querkraftbew,Verankerung,Darstellung", ",")
Sheets(ArrDruck).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(ArrDruck(0)).Select
Application.ScreenUpdating = True
End Sub
Sub Drucken_2()
Application.ScreenUpdating = False
Dim ArrDruck() As String, i
For i = 1 To ActiveWorkbook.Sheets.Count
ReDim Preserve ArrDruck(1 To i)
ArrDruck(i) = ActiveWorkbook.Sheets(i).Name
Next
Sheets(ArrDruck).Select
Application.Dialogs(xlDialogPrint).Show
Sheets(ArrDruck(1)).Select
Application.ScreenUpdating = True
End Sub

AW: Drucken auf Knopfdruck

24.11.2016 09:36:15

Klasse, funktioniert einwandfrei. Vielen Dank!

AW: Drucken auf Knopfdruck

24.11.2016 11:04:02

Eine Frage habe ich noch:
Wenn nun nicht alle Tabelleblätter eingeblendet sind, wie kann ich den Code ummodeln, sodass er mir keinen Fehler anzeigt? D.h. einige Blätter werden ein-/ausgeblendet und das Makro soll nur die eingeblendeten Blätter drucken...
Hat jemand noch eine zündende Idee? :)

@fsc AW: Drucken auf Knopfdruck

24.11.2016 13:52:05

@fsc AW: Drucken auf Knopfdruck

24.11.2016 23:42:50

fcs

Hallo Al,
dan muss man die Makros in folgende Richtung verfeinern.
Gruß
Franz

Sub Drucken()
'Drucken der sichtbaren Blätter aus einer Vorauswahl von Blättern in der aktiven  _
Arbeitsmappe
Dim ArrDruck() As String, varItem, k As Integer, strAktiv As String
Dim ArrVorauswahl As Variant
On Error GoTo Fehler
ArrVorauswahl = Split("InhaltsV,Vorbemerkung,Geometrie,Eingabe,Standsicherheit," _
& "Laengsbew,Querkraftbew,Verankerung,Darstellung", ",")
strAktiv = ActiveSheet.Name
For Each varItem In ArrVorauswahl
With ActiveWorkbook.Sheets(varItem)
If .Visible = xlSheetVisible Then
k = k + 1
ReDim Preserve ArrDruck(1 To k)
ArrDruck(k) = .Name
End If
End With
weiter:
Next
If k > 0 Then
Application.ScreenUpdating = False
Sheets(ArrDruck).Select
Application.Dialogs(xlDialogPrint).Show
Application.ScreenUpdating = True
Else
MsgBox "Es gibt keine zu druckenden Blätter"
End If
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 9 'Indexfehler
Resume weiter
Case Else
MsgBox "Fehler-Nr,: " & .nummer & vbLf & .Description
End Select
End With
ActiveWorkbook.Sheets(strAktiv).Select
End Sub
Sub Drucken_2()
'Drucken der sichtbaren Blätter der aktiven Arbeitsmappe
Dim ArrDruck() As String, i As Integer, k As Integer, strAktiv As String
strAktiv = ActiveSheet.Name
For i = 1 To ActiveWorkbook.Sheets.Count
With ActiveWorkbook.Sheets(i)
If .Visible = xlSheetVisible Then
k = k + 1
ReDim Preserve ArrDruck(1 To k)
ArrDruck(k) = .Name
End If
End With
Next
If k > 0 Then
Application.ScreenUpdating = False
Sheets(ArrDruck).Select
Application.Dialogs(xlDialogPrint).Show
Application.ScreenUpdating = True
Else
MsgBox "Es gibt keine zu druckenden Blätter"
End If
ActiveWorkbook.Sheets(strAktiv).Select
End Sub

@fsc AW: Drucken auf Knopfdruck

25.11.2016 08:14:37

Klasse, hat auf Anhieb geklappt! Tausend Dank und noch ein schönes Wochenende ;)

Beliebteste Forumthreads (12 Monate)

Forumthread: Drucken auf Knopfdruck

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread