Pokud vyberete více rozsahů buněk na jednom listu a pokusíte se vytisknout vybrané buňky, budete
získejte jeden list pro každou z vybraných oblastí.
Následující příklad makra vytiskne všechny vybrané oblasti na jeden list,
kromě případů, kdy jsou oblasti příliš velké na to, aby se vešly do jednoho listu.
Dílčí PrintSelectedCells () 'vytiskne vybrané buňky, použijte z tlačítka na panelu nástrojů nebo z nabídky Dim aCount As Integer, cCount As Integer, rCount As Integer Dim i As Integer, j As Long, aRange As String Dim rHeight () As Single, cWidth ( ) Jako jeden Dim AWB jako sešit, NWB jako sešit If UCase (TypeName (ActiveSheet)) "WORKSHEET" Then Exit Sub 'užitečné pouze v listech aCount = Selection.Areas.Count If aCount = 0 Then Exit Sub' no cells selected cCount = Selection.Areas (1) .Cells.Count If aCount> 1 Then 'selected areas selected Application.ScreenUpdating = False Application.StatusBar = "Printing" & aCount & "selected areas…" Set AWB = ActiveWorkbook rCount = ActiveSheet.Cells.SpecialCells (xlLastCell) .Row cCount = ActiveSheet.Cells.SpecialCells (xlLastCell) .Column ReDim rHeight (rCount) ReDim cWidth (cCount) For i = 1 To rCount 'najděte výšku řádku každého řádku ve výběru rHeight (i) = Rows (i) .Řádková výška Další i Pro i = 1 To cCount 'najděte šířku sloupce každého sloupce ve výběru cWidt h (i) = Sloupce (i). ColumnWidth Další i Nastavit NWB = Sešity. Přidat 'vytvořit nový sešit Pro i = 1 To rCount' nastavit výšky řádků Řádky (i) .RowHeight = rHeight (i) Další i Pro i = 1 To cCount 'nastavení šířky sloupců Columns (i) .ColumnWidth = cWidth (i) Next i For i = 1 To aCount AWB.Activate aRange = Selection.Areas (i) .Address' the range address Range (aRange) .Copy ' kopírování rozsahu NWB.Activate With Range (aRange) 'pastes values and format .PasteSpecial Paste: = xlValues, Operation: = xlNone, _ SkipBlanks: = False, Transpose: = False .PasteSpecial Paste: = xlFormats, Operation: = xlNone, _ SkipBlanks: = False, Transpose: = False End With Application.CutCopyMode = False Next i NWB.PrintOut NWB.Close False 'zavřete dočasný sešit bez uložení Application.StatusBar = False AWB.Activate Set AWB = Nothing Set NWB = Nothing Else If cCount <10 Then 'less than 10 cells selected If MsgBox („You are sure you want to print“ & _ cCount & „selected cells?“, _ VbQuestion + vbYesNo, „Print celected cells") = vbNo Th en Ukončit Sub End If Selection.PrintOut End If End Sub