• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: hromadný tisk přes makro

Zaslal/a Zpita 17.10.2019 6:54

Dobrý den všem,
prosím o radu ohledně hromadného tisku přes makro.
v sešitu mám 162 listů, 1.makro mám nastavené na tisk listů 3 až 42, 2.makro mám na tisk listů 43 až 82, 3.makro mám na tisk listů 83 až 122 a 4.makro mám na tisk listů 123 až 162. Dříve jsem měl pouze tři makra a vše fungovalo. Když jsem sešit rozšířil o čtvrté makro tak vše přestalo fungovat jak má.
Předem moc děkuji za rady.

makra:

Sub Tisk_ZL()
Dim A(), Pocet As Integer, Listy() As String, i As Byte

Pocet = -1
With ThisWorkbook
ReDim A(1 To 40, 1 To 1)
A = .Worksheets("Nástup prac.").Cells(3, 1).Resize(40).Value2

For i = 3 To 42
If Not IsEmpty(A(i - 2, 1)) And IsNumeric(A(i - 2, 1)) Then
Pocet = Pocet + 1
ReDim Preserve Listy(Pocet)
Listy(Pocet) = .Worksheets(i).Name
End If
Next i

If Pocet > -1 Then
'.Worksheets(Listy).Select
'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
.Worksheets(Listy).PrintPreview
End If
End With
End Sub

Sub Tisk_OOPP()
Dim A(), Pocet As Integer, Listy() As String, i As Byte

Pocet = -1
With ThisWorkbook
ReDim A(1 To 40, 1 To 1)
A = .Worksheets("Nástup prac.").Cells(3, 1).Resize(40).Value2

For i = 43 To 82
If Not IsEmpty(A(i - 42, 1)) And IsNumeric(A(i - 42, 1)) Then
Pocet = Pocet + 1
ReDim Preserve Listy(Pocet)
Listy(Pocet) = .Worksheets(i).Name
End If
Next i

If Pocet > -1 Then
'.Worksheets(Listy).Select
'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
.Worksheets(Listy).PrintPreview
End If
End With
End Sub

Sub Tisk_nářadí()
Dim A(), Pocet As Integer, Listy() As String, i As Byte

Pocet = -1
With ThisWorkbook
ReDim A(1 To 40, 1 To 1)
A = .Worksheets("Nástup prac.").Cells(3, 1).Resize(40).Value2

For i = 83 To 122
If Not IsEmpty(A(i - 82, 1)) And IsNumeric(A(i - 82, 1)) Then
Pocet = Pocet + 1
ReDim Preserve Listy(Pocet)
Listy(Pocet) = .Worksheets(i).Name
End If
Next i

If Pocet > -1 Then
'.Worksheets(Listy).Select
'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
.Worksheets(Listy).PrintPreview
End If
End With
End Sub
Sub Tisk_příloha()
Dim A(), Pocet As Integer, Listy() As String, i As Byte

Pocet = -1
With ThisWorkbook
ReDim A(1 To 40, 1 To 1)
A = .Worksheets("Nástup prac.").Cells(3, 1).Resize(40).Value2

For i = 123 To 162
If Not IsEmpty(A(i - 122, 1)) And IsNumeric(A(i - 122, 1)) Then
Pocet = Pocet + 1
ReDim Preserve Listy(Pocet)
Listy(Pocet) = .Worksheets(i).Name
End If
Next i

If Pocet > -1 Then
'.Worksheets(Listy).Select
'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
.Worksheets(Listy).PrintPreview
End If
End With
End Sub

Zaslat odpověď >

---

Stalker(17.10.2019 11:14)#044670

Co znamená: vše přestalo fungovat jak má???

Ve VBE si zobraz okno Locals
a kontroluj jakých hodnot nabývají proměnné.citovat

Zpita(17.10.2019 12:27)#044673

první makro mi tiskne list 1 místo listu 3 až 42,
druhé makro mi tiskne listy 3 až 42 místo listů 43 ž 82 a tak dál.citovat

Stalker(17.10.2019 12:45)#044676

viz předchozí reakce

Ve VBE si zobraz okno Locals
Klávesou F8 krokuj kód
a kontroluj jakých hodnot nabývají proměnné.citovat

Zpita(17.10.2019 13:01)#044677

tak jsem si to nakrokoval a vidím že makro tiskne špatné listy ale nevím jak to opravit.citovat

Zpita(17.10.2019 13:34)#044680

každé makro začíná tisknout o dva listy dříve než by mělo. Nevím jak to opravit. Děkuji moc.citovat

JoKe(17.10.2019 13:56)#044681

Já bych to viděl na to, že "ubyly" dva listy na začátku (i kdyby byly jen přesunuty). Tím se vše posunulo.citovat

Zpita(17.10.2019 14:03)#044682

Jsem blboun, dva listy jsem přidával a úplně jsem na to zapomněl. Už je to OK. Jediný problé který teď mám, je že prvních 40 oboustranných listů mi tiskne jednostranně (dva listy na jednu stránku). Ostatní jsou jednostranné a jsou OK.citovat

Zpita(17.10.2019 16:07)#044684

Ještě mám dotaz. Jde u těchto maker nastavit hromadně jednostranný nebo oboustranný tisk na síťovou tiskárnu?
1. makro (list 5 až 44) = oboustranně
2. makro (list 45 až 84) = jednostranně
3. makro (list 85 až 124) = jednostranně
4. makro (list 125 až 164) = jednostranně

jde mi o to, že když tiskne někdo jiný, a má nastavenou jinou výchozí tiskárnu ve svém PC tak mi vždy rozháže nastavení tisku (jednostanně/oboustranně)
viz makro níže. Moc děkuji.

Sub Tisk_ZL()
Dim A(), Pocet As Integer, Listy() As String, i As Byte

Pocet = -1
With ThisWorkbook
ReDim A(1 To 40, 1 To 1)
A = .Worksheets("Nástup prac.").Cells(3, 1).Resize(40).Value2

For i = 5 To 44
If Not IsEmpty(A(i - 4, 1)) And IsNumeric(A(i - 4, 1)) Then
Pocet = Pocet + 1
ReDim Preserve Listy(Pocet)
Listy(Pocet) = .Worksheets(i).Name
End If
Next i

If Pocet > -1 Then
'.Worksheets(Listy).Select
'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
.Worksheets(Listy).PrintPreview
End If
End With
End Sub

Sub Tisk_OOPP()
Dim A(), Pocet As Integer, Listy() As String, i As Byte

Pocet = -1
With ThisWorkbook
ReDim A(1 To 40, 1 To 1)
A = .Worksheets("Nástup prac.").Cells(3, 1).Resize(40).Value2

For i = 45 To 84
If Not IsEmpty(A(i - 44, 1)) And IsNumeric(A(i - 44, 1)) Then
Pocet = Pocet + 1
ReDim Preserve Listy(Pocet)
Listy(Pocet) = .Worksheets(i).Name
End If
Next i

If Pocet > -1 Then
'.Worksheets(Listy).Select
'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
.Worksheets(Listy).PrintPreview
End If
End With
End Sub

Sub Tisk_nářadí()
Dim A(), Pocet As Integer, Listy() As String, i As Byte

Pocet = -1
With ThisWorkbook
ReDim A(1 To 40, 1 To 1)
A = .Worksheets("Nástup prac.").Cells(3, 1).Resize(40).Value2

For i = 85 To 124
If Not IsEmpty(A(i - 84, 1)) And IsNumeric(A(i - 84, 1)) Then
Pocet = Pocet + 1
ReDim Preserve Listy(Pocet)
Listy(Pocet) = .Worksheets(i).Name
End If
Next i

If Pocet > -1 Then
'.Worksheets(Listy).Select
'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
.Worksheets(Listy).PrintPreview
End If
End With
End Sub

Sub Tisk_příloha()
Dim A(), Pocet As Integer, Listy() As String, i As Byte

Pocet = -1
With ThisWorkbook
ReDim A(1 To 40, 1 To 1)
A = .Worksheets("Nástup prac.").Cells(3, 1).Resize(40).Value2

For i = 125 To 164
If Not IsEmpty(A(i - 124, 1)) And IsNumeric(A(i - 124, 1)) Then
Pocet = Pocet + 1
ReDim Preserve Listy(Pocet)
Listy(Pocet) = .Worksheets(i).Name
End If
Next i

If Pocet > -1 Then
'.Worksheets(Listy).Select
'Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
.Worksheets(Listy).PrintPreview
End If
End With
End Subcitovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse