Ahoj,
zkus tohle:
Sub TiskVybraneTabulky()
Dim ws As Worksheet
Dim tabulka As String
Dim pctKopii As Integer
' Nastav list, kde se nachází tabulky
Set ws = ThisWorkbook.Sheets("Print")
' Výběr tabulky a počet kopií
tabulka = InputBox("Zadejte číslo tabulky k tisku (1 pro tabulku B134:M266, 2 pro tabulku R80:AD127):", "Výběr tabulky")
pctKopii = InputBox("Zadejte počet kopií:", "Počet kopií")
' Kontrola platnosti vstupů
If (tabulka <> "1" And tabulka <> "2") Or Not IsNumeric(pctKopii) Or pctKopii < 1 Then
MsgBox "Neplatný vstup. Prosím zkuste to znovu."
Exit Sub
End If
' Nastavení oblasti tisku podle výběru
Select Case tabulka
Case "1"
ws.PageSetup.PrintArea = "$B$134:$M$266"
Case "2"
ws.PageSetup.PrintArea = "$R$80:$AD$127"
End Select
' Tisk vybrané oblasti s požadovaným počtem kopií
ws.PrintOut Copies:=pctKopii
End Sub
citovat
zkus tohle:
Sub TiskVybraneTabulky()
Dim ws As Worksheet
Dim tabulka As String
Dim pctKopii As Integer
' Nastav list, kde se nachází tabulky
Set ws = ThisWorkbook.Sheets("Print")
' Výběr tabulky a počet kopií
tabulka = InputBox("Zadejte číslo tabulky k tisku (1 pro tabulku B134:M266, 2 pro tabulku R80:AD127):", "Výběr tabulky")
pctKopii = InputBox("Zadejte počet kopií:", "Počet kopií")
' Kontrola platnosti vstupů
If (tabulka <> "1" And tabulka <> "2") Or Not IsNumeric(pctKopii) Or pctKopii < 1 Then
MsgBox "Neplatný vstup. Prosím zkuste to znovu."
Exit Sub
End If
' Nastavení oblasti tisku podle výběru
Select Case tabulka
Case "1"
ws.PageSetup.PrintArea = "$B$134:$M$266"
Case "2"
ws.PageSetup.PrintArea = "$R$80:$AD$127"
End Select
' Tisk vybrané oblasti s požadovaným počtem kopií
ws.PrintOut Copies:=pctKopii
End Sub
citovat
\n
RSS nejnovější články