Tak jsem to nějak spatlal, ale občas si to hraje s tím logem a přidává ještě jedno, nevím, zda jsem to udělal nějak špatně, ale pro jistotu přidávám kód...
Private Sub Akce_Tisk()
' muzes nastavit oblasti tisku a jine parametry pro tisk atd ...
Range("A21:H21").Select
Application.PrintCommunication = True
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
For eTab = 1 To 2
rdW = (eTab - 1) * Cells(1, 14) + 1
rdLast = Cells(eTab, 14)
ActiveSheet.Range(Cells(rdW, 1), Cells(rdLast, 13)) _
.PrintOut Copies:=1, _
ActivePrinter:="\\T2315.aero.cz\KONICA MINOLTA magicolor 2500W:" 'dosadit svou tiskárnu
Next eTab
ActiveSheet.HPageBreaks(1).Delete
MsgBox "Dokument odeslán do tiskárny"
End Sub
Mrkni se mi prosím, zda je vše, tak jak má být.
citovat