Příspěvky uživatele


< návrat zpět

Makro - tisk na síťovou tiskárnu (18.10.2019 9:09)

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

hromadný tisk přes makro (17.10.2019 16:07)

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

hromadný tisk přes makro (17.10.2019 14:03)

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.

hromadný tisk přes makro (17.10.2019 13:34)

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

hromadný tisk přes makro (17.10.2019 13:01)

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

hromadný tisk přes makro (17.10.2019 12:27)

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.

hromadný tisk přes makro (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

funkce KDYŽ NEBO (23.9.2019 16:00)

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.

když je prázdných více buněk (23.7.2019 20:01)

Moc děkuji.

když je prázdných více buněk (23.7.2019 14:09)

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)
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