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

MS Excel

Téma: Tisk pomocí makra podle podmínky

Zaslal/a Ven 1.8.2018 13:37

Dobrý den,
chtěla bych vás poprosit o radu k vba kodu pro tisk.
Mám jeden list, který obsahuje množství dat, které jsou rozděleny na stránky (celkem 6), první dvě stránky chci tisknout vždy, zbytek stránek chci tisknout pouze tehdy zda buňka ve sloupci B na začátku listu obsahuje číslo vybrané přílohy (1 až 4). Toto číslo je zadáváno automaticky v případě, že se z rozevíracího seznamu na konci druhé stránky vybere daný název listu.

Já vba kod mám, ten mi ale bohužel zobrazí v pdf i ty stránky, které nemají přiřazené číslo. Např. Jako přílohu 1 vyberu stránku č. 3 a jako přílohu 2 vyberu stránku č. 5. První dvě stránky se vytisknou vždy, poté se mi vytisknou stránky 3 až 5, i přesto, že stránka č. 4 nemá přidělené číslo přílohy. Stránka č. se již nevytiskne, ta také nemá přidělené číslo. Tudíž nevím kde je problém. Děkuji za každou radu.

Kod:
Sub Tisk()

If Range("B96").Text = "1" Then
Range("A96:I143").Select
End If

If Range("B144").Text = "2" Then
Range("A144:I187").Select
End If
If Range("B144").Text = "3" Then
Range("A144:I187").Select
End If
If Range("B144").Text = "4" Then
Range("A144:I187").Select
End If

If Range("B191").Text = "2" Then
Range("A191:I232").Select
End If
If Range("B191").Text = "3" Then
Range("A191:I232").Select
End If
If Range("B191").Text = "4" Then
Range("A191:I234").Select
End If

If Range("B238").Text = "2" Then
Range("A238:I282").Select
End If
If Range("B238").Text = "3" Then
Range("A238:I282").Select
End If
If Range("B238").Text = "4" Then
Range("A238:I283").Select
End If

ActiveSheet.PageSetup.PrintArea = Range("$A$1:$I$95", Selection).Address
ActiveSheet.PrintOut Preview:=True

End Sub

(Poznámka: Kod je zbytečně dlouhý, já vím, šlo by to udělat i jinak, nebo že oblast >0. Ale problém je stejný.)

Zaslat odpověď >

---

Strana:  « předchozí  1 2 3

elninoslov(6.8.2018 14:44)#041047

Excel Vám to moje predošlé makro nezobral asi len kvôli tomu, že pri kopírovaní z fóra vkladá medzery medzi riadky. A zložený príkaz nesmie mať v sebe prázdne riadky. Stačilo odstrániť medzery.

Každopádne, tu je ďalší návrh s malým rozdielom číslovania príloh, ale tentoraz som použil malý cyklus, ktorý bude možno pochopiteľnejší. Prílohy budú očíslované v zadanom poradí, len sa vytlačia v poradí, ako idú pod sebou. Ale čísla budú mať aké im určíte Vy.

Stále trváte na tom, že sú oblasti rovnaké ? Poriadne sa pozrite na "A191:I232" vs "A191:I234" pre rovnakú prílohu. Detto v poslednej prílohe.
Ďalej prvá príloha je o riadok vyššia, ale budiš, nevadí.

Nečítal som všetko, ani nepozeral pridané riešenia, tak snáď neduplikujem.

Ak to ani takto nevyhovuje, tak potom (možno to tu už je) tlačte po jednotlivých prílohách pomocou cyklu. Prvá tlač tie 2 hlavné strany, druhá samostatná tlač bude prvá zvolená príloha, tretia samostatná tlač bude druhá zvolená príloha, atď. Kliknete rovnako iba raz na tlačítko, akurát nebudete mať ten Preview. Aj to je možnosť.

Sub Tisk()
Dim sOblast As String, AdrP, i As Byte

With ThisWorkbook.ActiveSheet
AdrP = Split("B96,B144,B191,B238", ",")
sOblast = "$A$1:$I$95 "
For i = 0 To 3
If IsNumeric(.Range(AdrP(i)).Value) Then
sOblast = sOblast & .Range(AdrP(i)).Offset(, -1).Resize(47, 9).Address & " "
End If
Next i
sOblast = Replace(WorksheetFunction.Trim(sOblast), " ", ",")
.PageSetup.PrintArea = sOblast
.PrintOut Preview:=True
End With
End Sub

Příloha: 41047_makro-tisk-priloh.zip (272kB, staženo 22x)

citovat

Venali(7.8.2018 7:29)#041054

Stalker: Děkuji za alternativní možnost.

elninoslov: Děkuji, makro s malým cyklem nyní dělá to co chci, to je fajn, jen s malou chybičkou, zatím jsem nepřišla na to proč to dělá. Při kliknutí na tisk, mi vytiskne ne A:I ale B:J od stránky č. 3. Tudíž u příloh vynechává sloupec A, stránka se posune o tento sloupec. Je možné, že je chyba v makru? Po úpravě stránek pro tisk, je to v pohodě, ale po zavření a opětovném otevření souboru se chyba opakuje.

Ten původní kod mi i po odstranění mezer, dělá to stejné, co ten můj původní, tedy tiskne i stránky příloh, které tisknout nechci.citovat

elninoslov(7.8.2018 9:09)#041056

Áno, zabudol som na posun, doplnte si vyznačenú časť do daného riadku:
sOblast = sOblast & .Range(AdrP(i)).Offset(, -1).Resize(47, 9).Address & " "citovat

Venali(7.8.2018 9:19)#041057

Elninoslov. Děkuji moc za úpravu, moc mi to pomohlo.

Také chci poděkovat všem, kteří se zapojili do diskuze. Děkuji za vaše návrhy a poznámky.citovat

marjankaj(7.8.2018 9:26)#041058

Ten prvý kód od elninoslov úplne stačil. Ale bez tej prílohy nemohol tušiť, čo porovnávaš.
Sub Tisk()
Dim sOblast As String

With ThisWorkbook.ActiveSheet
sOblast = Replace(WorksheetFunction.Trim("$A$1:$I$95 " & _
IIf(.Range("B96") = "", "A96:I143 ", "") & _
IIf(.Range("B144") = "", "A144:I187 ", "") & _
IIf(.Range("B191") = "", "A191:I232 ", "") & _
IIf(.Range("B238") = "", "A238:I282 ", "")), " ", ",")
.PageSetup.PrintArea = sOblast
.PrintOut Preview:=True
End With
End Sub
alebo v tých vzorčekoch treba vymeniť =IFERROR(MATCH(List2!A1;$B$89:$B$93;0);"")
za
=IFERROR(MATCH(List2!A1;$B$89:$B$93;0);0)

Treba vedieť čo porovnávaš.citovat

Venali(7.8.2018 9:32)#041059

marjankaj: tak to potom jo, ale zapomněla jsem, že jsem vyměnila ve vzorcích 0 za mezeru, proto mi to nefungovalo. Děkuji.citovat

marjankaj(7.8.2018 9:40)#041060

Venali napsal/a:

marjankaj: tak to potom jo, ale zapomněla jsem, že jsem vyměnila ve vzorcích 0 za mezeru, proto mi to nefungovalo. Děkuji.

Ale my sme to nemohli tušiť. Ty môžeš napísať jedno a my si myslíme niečo iné. Preto je dobré dávať tú prílohu. Tam sa to presne ukáže. Aj keď niekedy by bolo dobré vedieť, ako si predstavuješ výstup. Z popisu to vždy nemusí byť jasné.citovat

Strana:  « předchozí  1 2 3

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse