Hvis du vælger flere celleområder på et ark og forsøger at udskrive udvalgte celler, vil du gøre det
få et ark til hvert af de valgte områder.
Følgende eksempelmakro udskriver alle de valgte områder på et ark,
undtagen hvis områderne er for store til at passe i et ark.
Sub PrintSelectedCells () 'udskriver udvalgte celler, brug fra en værktøjslinjeknap eller en menu 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 ( ) Som enkelt dim AWB som arbejdsmappe, NWB som projektmappe Hvis UCase (TypeName (ActiveSheet)) "WORKSHEET" Afslut derefter Sub 'kun nyttig i regneark aCount = Selection.Areas.Count Hvis aCount = 0 Afslut derefter Sub' ingen celler valgt cCount = Selection.Areas (1) .Cells.Count If aCount> 1 Herefter valgte flere områder Application.ScreenUpdating = Falsk Application.StatusBar = "Udskrivning" & aCount & "valgte områder …" Angiv 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 'find rækkehøjden for hver række i markeringen rHøjde (i) = Rækker (i) .RowHeight Næste i For i = 1 Til cCount 'find kolonnebredden for hver kolonne i markeringen cWidt h (i) = Kolonner (i) .ColumnWidth Next i Set NWB = Workbooks.Add 'create a new workbook For i = 1 To rCount' set row heights Rows (i) .RowHeight = rHeight (i) Next i For i = 1 Til cCount 'indstil kolonnebredder Kolonner (i) .ColumnWidth = cWidth (i) Næste i For i = 1 Til aCount AWB.Activate aRange = Selection.Areas (i) .Adress' 'range address Range (aRange) .Copy' kopiering af området NWB.Activate With Range (aRange) 'indsætter værdier og formater .PasteSpecial Paste: = xlValues, Operation: = xlNone, _ SkipBlanks: = False, Transpose: = False .PasteSpecial Paste: = xlFormats, Operation: = xlNone, _ SkipBlanks: = Falsk, Transpose: = Falsk ende med Application.CutCopyMode = Falsk Næste i NWB.PrintOut NWB.Luk Falsk 'luk den midlertidige projektmappe uden at gemme Application.StatusBar = Falsk AWB.Activate Set AWB = Intet sæt NWB = Intet andet Hvis cCount <10 Så er der valgt mindre end 10 celler Hvis MsgBox ("Er du sikker på, at du vil udskrive" & _ cCount & "markerede celler?", _ VbQuestion + vbYesNo, "Udskriv valgte celler") = vbNo Th da Afslut Sub End If Selection. PrintOut End If End Sub