Als u meerdere celbereiken op één blad selecteert en de geselecteerde cellen probeert af te drukken, zult u:
krijg een blad voor elk van de geselecteerde gebieden.
De volgende voorbeeldmacro drukt alle geselecteerde gebieden op één vel af,
behalve als de gebieden te groot zijn om in één vel te passen.
Sub PrintSelectedCells() ' drukt geselecteerde cellen af, gebruik een werkbalkknop of een 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( ) Als Single Dim AWB als werkboek, NWB als werkboek If UCase(TypeName(ActiveSheet)) "WORKSHEET" Then Exit Sub ' alleen nuttig in werkbladen aCount = Selection.Areas.Count If aCount = 0 Then Exit Sub ' geen cellen geselecteerd cCount = Selection.Areas(1).Cells.Count Indien aCount > 1 Dan ' meerdere gebieden geselecteerd Application.ScreenUpdating = False Application.StatusBar = "Afdrukken" & aCount & " geselecteerde gebieden… " 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 ' zoek de rijhoogte van elke rij in de selectie rHeight(i) = Rows (i).RowHeight Volgende i For i = 1 To cCount ' zoek de kolombreedte van elke kolom in de selectie cWidt h(i) = Columns(i).ColumnWidth Next i Set NWB = Workbooks.Add ' maak een nieuwe workbook For i = 1 To rCount ' stel rijhoogten in Rows(i).RowHeight = rHeight(i) Next i For i = 1 Om cCount ' kolombreedtes in te stellen 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 ' het bereik kopiëren NWB.Activate With Range(aRange) ' plakt waarden en formaten .PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End With Application.CutCopyMode = False Volgende i NWB.PrintOut NWB.Close False ' sluit de tijdelijke werkmap zonder op te slaan Application.StatusBar = False AWB.Activate Set AWB = Niets ingesteld NWB = Niets anders Als cCount < 10 Dan ' minder dan 10 cellen geselecteerd If MsgBox("Weet u zeker dat u wilt afdrukken " & _ cCount & " geselecteerde cellen?", _ vbQuestion + vbJaNee, "Geselecteerde cellen afdrukken") = vbNee Th nl Exit Sub End If Selection.PrintOut End If End Sub