Drucken auf Knopfdruck

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread