Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1400to1404
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

Drucken mit vba & Abfrage nach Tabellenblatt

Drucken mit vba & Abfrage nach Tabellenblatt
13.01.2015 09:41:36
Dominic
Hallo zusammen,
Aktuell nutze ich folgendes Skript um zwei bestimmte Tabellenblätter auszudrucken.
Ich möchte das ganze aber weiter invidualisieren, so dass vor dem Druck Excel abfragen soll, "wie viele Kalkulationen sollen ausgedruckt werden?"
Der User kann dann einen Wert von 1-10 eintragen und in Abhängigkeit der Eingabe soll Excel dann das Tabellenblatt:
Bei Eingabe der Zahl 1 = Excel druckt Tabellenblatt "P1"
Bei Eingabe der Zahl 2 = Excel druckt das Tabellenblatt "P1" und "P2"
Bei Eingabe der Zahl 3 = Excel druckt das Tabellenblatt "P1", "P2" und "P3"
...
If Range("O1") = "Wahr" Then
Sheets(Array("P1", "P2")).Select
Else
Sheets("P1").Activate
End If
With .PageSetup
.Zoom = False
.PrintArea = "$A$1:$G$54"
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.Dialogs(xlDialogPrint).Show
End If
End With

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

Betreff
Datum
Anwender
Anzeige
AW: Drucken mit vba & Abfrage nach Tabellenblatt
13.01.2015 10:40:55
fcs
Hallo Dominic,
nachfolgend dein Makro entsprechend ergänzt/angepasst.
Mir ist aber nicht klar, auf welches Blatt sich PageSetup bezieht.
Bei mir wird jedes der P-Blätter jetzt so eingerichtet. Wenn es ein anderes Blatt sein soll, dann musst du den PageSetup-Abschnitt aus der For-Next-Schleife rausnehmen und statt objSheet das entssprechede Blatt einsetzen - z.B.: Sheets("Blatt ABC")
Gruß
Franz
Sub Drucken_P_Blaetter()
Dim arrSheets() As String, intNr As Integer, intS As Integer, objSheet As Object
Dim objSheetAktiv As Object
Dim varAnzahl
On Error GoTo Fehler
Eingabe_Anzahl:
varAnzahl = Application.InputBox( _
Prompt:="Wie viele Rechnungsblätter sollen gedruckt werden (1 bis 10)?", _
Title:="Rechnungsblätter gruppiert drucken", _
Default:=1, _
Type:=1)
Select Case varAnzahl
Case 0
'Eingabe wurde abgebrochen oder 0 eingegeben
Case 1 To 10
Set objSheetAktiv = ActiveSheet 'aktives Blatt merken
For intNr = 1 To varAnzahl
Set objSheet = ActiveWorkbook.Sheets("P" & Format(intNr, "0"))
intS = intS + 1
ReDim Preserve arrSheets(1 To intS)
arrSheets(intS) = objSheet.Name
'Seite einrichten Blatt
With objSheet.PageSetup
.Zoom = False
.PrintArea = "$A$1:$G$54"
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next_intNr:
Next
ActiveWorkbook.Sheets(arrSheets).Select
Application.Dialogs(xlDialogPrint).Show
objSheetAktiv.Select
Case Else
If MsgBox("unzulässiger Wert für die Anzahl zu druckender Rechnungsblätter", _
vbInformation + vbRetryCancel, "Drucken Rechnungsblätter") = vbRetry Then
GoTo Eingabe_Anzahl
End If
End Select
Fehler:
With Err
Select Case .Number
Case 0 'alles Ok
Case 9 'Index-Fehler - Blatt mit Name "P" & intNr existiert nicht
Resume Next_intNr
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Anzeige
AW: Drucken mit vba & Abfrage nach Tabellenblatt
13.01.2015 13:50:11
Dominic
Hi Franz,
vielen Dank schon mal. Ja genau richtig, das PageSetup jedes Tabellenblatt einrichtet.
Ich habe nun noch eine IF Abfrage eingefügt, leider scheint die Prüfung nicht richtig deklariert zu sein, da bei mir immer die MSG Box mit dem eingetragenen Fehlertext erscheint. Ich komme nie zu deinem Teils des Skripts durch.
Kannst du mir hierbei bitte noch einmal weiterhelfen?
Vielen Dank!
Aktuell sieht es wie folgt aus:
Sub Drucken_P_Blaetter()
Dim arrSheets() As String, intNr As Integer, intS As Integer, objSheet As Object
Dim objSheetAktiv As Object
Dim varAnzahl
Dim byWert As Byte
If Sheets("Gesamt").Range("M3") = "Ja" And Sheets("Gesamt").Range("M1") 

Anzeige
AW: Drucken mit vba & Abfrage nach Tabellenblatt
13.01.2015 14:51:16
Dominic
Achja, und wenn das Druck Makro ausgeführt wird, und der User seine Eingabe (1-10) getätigt hat, muss immer das Tabellenblatt "Gesamt" mit ausgedruckt werden.
Kannst du das noch irgendwie in das o. g. Makro integrieren? So dass alles in einem Printer Dialog ausgegeben wird und nicht zwei dedizierte öffnet? :)
Vielen DANK! :)

AW: Drucken mit vba & Abfrage nach Tabellenblatt
13.01.2015 17:01:05
Dominic
Ich hoffe Ihr könnt mir bei dem letzten Schritt noch weiterhelfen? :)
Danke :)

AW: Drucken mit vba & Abfrage nach Tabellenblatt
13.01.2015 19:35:07
fcs
Hallo Dominic,
bei dir war die Auswertung der MsgBox mit Ja/Nein-Schaltflächen nicht korrekt und die End Ifs muss man auch anders setzen.
Außerdem sollte der Wert in M1 für die Prüfung gerundet werden, denn 0,9999 ist immer noch kleiner 1.
Das Blatt "Gesamt" muss vor der For-Next-Schleife als 1. Element in das Array für die zu druckenden Blätter eingefügt werden.
Gruß
Franz
Sub Drucken_P_Blaetter()
Dim arrSheets() As String, intNr As Integer, intS As Integer, objSheet As Object
Dim objSheetAktiv As Object
Dim varAnzahl
Dim byWert As Byte
On Error GoTo Fehler
If Sheets("Gesamt").Range("M3") = "Ja" _
And VBA.Round(Sheets("Gesamt").Range("M1"), 3) =99,95% = OK
byWert = MsgBox( _
"Es gibt einen Fehler bei der Umlage der monatlichen Gebühr." _
& vbCrLf & vbCrLf _
& "Bitte prüfen Sie die jew. Produkt Anteiligkeit - zu finden jeweils in " _
& "Zelle C37 - da die Summer der Anteile aktuell bei unter  100% liegt!" _
& vbCrLf & vbCrLf & "Kalkulation dennoch ausdrucken?", _
4, "Plausibilitätsprüfung  fehlgeschlagen") '4 = vbYesNo
If byWert = 7 Then '7 = vbNo
MsgBox "Der Druck wird nicht ausgeführt"
GoTo Fehler
ElseIf byWert = 6 Then ' 6 = vbYes
'do nothing - macht nach End If weiter
Else
GoTo Fehler
End If
End If
Eingabe_Anzahl:
varAnzahl = Application.InputBox( _
Prompt:="Wie viele Rechnungsblätter sollen gedruckt werden (1 bis 10)?", _
Title:="Rechnungsblätter gruppiert drucken", _
Default:=1, _
Type:=1)
Select Case varAnzahl
Case 0
'Eingabe wurde abgebrochen oder 0 eingegeben
Case 1 To 10
Set objSheetAktiv = ActiveSheet 'aktives Blatt merken
Set objSheet = ActiveWorkbook.Sheets("Gesamt")
intS = intS + 1
ReDim Preserve arrSheets(1 To intS)
arrSheets(intS) = objSheet.Name
'Seite einrichten Blatt "Gesamt"
With objSheet.PageSetup
.Zoom = False
.PrintArea = "$A$1:$G$54"
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
For intNr = 1 To varAnzahl
Set objSheet = ActiveWorkbook.Sheets("P" & Format(intNr, "0"))
intS = intS + 1
ReDim Preserve arrSheets(1 To intS)
arrSheets(intS) = objSheet.Name
'Seite einrichten Blatt
With objSheet.PageSetup
.Zoom = False
.PrintArea = "$A$1:$G$54"
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next_intNr:
Next
ActiveWorkbook.Sheets(arrSheets).Select
Application.Dialogs(xlDialogPrint).Show
objSheetAktiv.Select
Case Else
If MsgBox("unzulässiger Wert für die Anzahl zu druckender Rechnungsblätter", _
vbInformation + vbRetryCancel, "Drucken Rechnungsblätter") = vbRetry Then
GoTo Eingabe_Anzahl
End If
End Select
Fehler:
With Err
Select Case .Number
Case 0 'alles Ok
Case 9 'Index-Fehler - Blatt mit Name "P" & intNr existiert nicht
Resume Next_intNr
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Anzeige
AW: Drucken mit vba & Abfrage nach Tabellenblatt
14.01.2015 10:10:44
Dominic
Hallo Franz,
super vielen vielen Dank!
Es funktioniert einwandfrei! :)
Gruß

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige