< návrat zpět

MS Excel

Téma: hromadný tisk přes makro rss

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
Stalker
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
avatar
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
Stalker
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
avatar
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
avatar
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
avatar
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
avatar
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
avatar
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)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje