Hallo Leute,
habe vor kurzer Zeit eine Inventurliste programmiert. diese kann blätter einfügen, löschen, …
Nun will ich eine Druckprozedur dazu programmieren, komme aber nicht mehr weiter. kA, was das Problem ist.
Zu meinem Problem:
ich habe auf dem Übersichtsblatt zwei Steuerelemente (buttons).
-
für Übersichtsblatt drucken
-
für alle anderen Blätter drucken
-
Sub Uebersichtdrucken()
Dim countsheet As Integer
Dim i As Integer
Dim pwd As String
Dim l As Integer
pwd = „basti06“
Sheets(„Übersicht“).Unprotect pwd
Sheets(„Übersicht“).Activate
Range(„A2:smiley:6,A7:A38,B9:smiley:38,D7:smiley:8,C7:C8“).Select
Selection.Interior.ColorIndex = xlNone
ActiveSheet.PageSetup.PrintArea = Range(„A2:smiley:38“).Address
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Range(„A2:smiley:6,A7:A38,B9:smiley:38,D7:smiley:8,C7:C8“).Select
Selection.Interior.ColorIndex = 36
Sheets(„Übersicht“).Protect pwd
End Sub
Diese Sub funktioniert auch und habe kein Problem. Es druck genau den Bereich, denn ich will.
- Sub Blaetterdrucken()
Dim countsheets As Integer
Dim i As Integer
Dim pwd As String
pwd = „basti06“
For i = 1 To Sheets.Count - 2
Worksheets(i).Unprotect pwd
Next i
countsheets = Sheets.Count - 2
For i = 1 To countsheets
Sheets(i).Select
Range(„A1:A6,B1:G1,C2:G6,B4:B6,E7:F55,A55:G55,A56:A58,D56:F58“).Select
Range(„D56“).Activate
Selection.Interior.ColorIndex = 36
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = „$A$1:blush:G$58“
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.PrintTitleRows = „“
.PrintTitleColumns = „“
End With
ActiveSheet.PageSetup.PrintArea = „$A$1:blush:G$58“
With ActiveSheet.PageSetup
.LeftHeader = „“
.CenterHeader = „“
.RightHeader = „“
.LeftFooter = „“
.CenterFooter = „“
.RightFooter = „“
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 97
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next i
End Sub
Bei dieser Sub funktioniert der Druckvorgang nicht bzw. das Übersichtsblatt wird gedruckt, jedoch 2 mal, dann wechselt er auf das Blatt 1 und druckt es auch, aber nicht mit richtigen Druckbereich.
Könnte mir hier jemand weiterhelfen. Finde leider keine Lösung.
Über jede Antwort, bin ich sehr dankbar.
Gruß,
Sebastian
