Kui valite ühel lehel mitu lahtrivahemikku ja proovite valitud lahtreid välja printida
saada üks leht iga valitud ala kohta.
Järgmine näite makro prindib kõik valitud alad ühele lehele,
välja arvatud juhul, kui alad on ühele lehele mahutamiseks liiga suured.
Sub PrintSelectedCells () 'prindib valitud lahtrid, kasutage tööriistariba nuppu või menüüd Dim aCount As Integer, cCount As Integer, rCount As Integer Dim i As Integer, j Nagu Long, aRange As String Dim rHeight () Single, cWidth ( ) Ühevärvilisena AWB töövihikuna, NWB töövihikuna Kui UCase (TypeName (ActiveSheet)) "WORKSHEET", siis Exit Sub 'on kasulik ainult töölehtedel aCount = Selection.Areas.Count If aCount = 0 Siis Exit Sub' lahtreid pole valitud cCount = Selection.Areas (1) .Cells.Count Kui aCount> 1 Siis valiti mitu piirkonda Application.ScreenUpdating = False Application.StatusBar = "Printimine" ja aCount & "valitud alad …" Set AWB = ActiveWorkbook rCount = ActiveSheet.Cells.SpecialCells (xlLastCell). Rida cCount = ActiveSheet.Cells.SpecialCells (xlLastCell). Veerg ReDim rHeight (rCount) ReDim cWidth (cCount) I = 1 To rCount 'leidke valiku iga rea rea kõrgus rHeight (i) = Rows (i) .RowHeight Järgmine i For i = 1 To cCount "leidke valiku cWidt iga veeru veerulaius h (i) = Veerud (i). Veerulaius Järgmine i Määra NWB = Töövihikud. Lisage "looge uus töövihik I = 1 To rCount" määrake ridade kõrgused Ridad (i). RowHeight = rHeight (i) Järgmine i For i = 1 To cCount 'määrake veerulaiused Veerud (i). ColumnWidth = cWidth (i) Järgmine i For i = 1 ACount AWB -le. Aktiveeri aRange = Selection.Areas (i). Aadress' vahemiku aadress Range (aRange) .Copy ' vahemiku NWB.Activate With Range (aRange) kopeerimine 'kleebib väärtused ja vormingud .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 "sulgege ajutine töövihik ilma rakendust salvestamata. StatusBar = False AWB. Activate Set AWB = Nothing Set NWB = Nothing Else Kui cCount <10, siis on valitud vähem kui 10 lahtrit Kui MsgBox ("Kas olete kindel, et soovite printida" & _ cCount & "valitud lahtrid?", _ VbQuestion + vbYesNo, "Prindi valitud lahtrid") = vbNo Th et Välju Sub End Kui valik. Printi