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

Příspěvky uživatele

Dobrý den všem,
pomohl by mi někdo upravit makro napsané níže, tak aby mi vždy tisklo na konkrétní síťovou tiskárnu. Tiskne se z různých PC a pokud má někdo nastavenou jako výchozí jinou tiskárnu, tak mi vždy rozhážou nastavení tisku. Tisknu listy 5 až 44 oboustranně.
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

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 Sub

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.

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

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

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.

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

Ahoj všem,
mohl by mi prosím někdo poradit jak napsat funkci KDYŽ NEBO.
Potřebuji například do buňky F7 napsat funkci:
když D7=so nebo ne, tak nic, jinak "1.O"

Moc děkuji.

Moc děkuji.

Dobrý den všem,
mohl by mi prosím někdo poradit se vzorcem.
když buňka A1:C1 obsahuje něco, tak = 12345
když je jakákoliv buňka A1 nebo B1 nebo C1 prázdná tak =""
níže mám vzorec který funguje pouze podle buňky A1
=KDYŽ(A(JE.PRÁZDNÉ(A1:C1));"";"12345")
Předem moc děkuji.

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse