mehrere Auswahlen auf einem Blatt Wenn Sie mehrere Zellbereiche auf einem Blatt auswählen und versuchen, ausgewählte Zellen auszudrucken, erhalten Sie für jeden der ausgewählten Bereiche ein Blatt.

Das folgende Beispielmakro druckt alle ausgewählten Bereiche auf einem Blatt, außer wenn die Bereiche zu groß sind, um in ein Blatt zu passen.

Sub PrintSelectedCells()

' prints selected cells, use from a toolbar button or a 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() As Single

Dim AWB As Workbook, NWB As Workbook

If UCase(TypeName(ActiveSheet)) <> "WORKSHEET" Then Exit Sub

' useful only in worksheets

aCount = Selection.Areas.Count

If aCount = 0 Then Exit Sub ' no cells selected

cCount = Selection.Areas(1).Cells.Count

If aCount > 1 Then ' multiple 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

' find the row height of every row in the selection

rHeight(i) = Rows(i).RowHeight

Next i

For i = 1 To cCount

' find the column width of every column in the selection

cWidth(i) = Columns(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 To cCount ' set column widths

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 ' copying the range

NWB.Activate

With Range(aRange) ' pastes values and formats

.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 ' close the temporary workbook without saving

Application.StatusBar = False

AWB.Activate

Set AWB = Nothing

Set NWB = Nothing

Else

If cCount < 10 Then ' less than 10 cells selected

If MsgBox("Are you sure you want to print " & _

cCount & " selected cells ?", _

vbQuestion + vbYesNo, "Print celected cells") = vbNo Then Exit Sub

End If

Selection.PrintOut

End If

End Sub