If you select multiple cell ranges on one sheet and tries to print out selected cells you will
get one sheet for each of the selected areas.
The following example macro will print all the selected areas on one sheet,
except if the areas are too large to fit in one sheet.
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
|
Word 2002: The Complete Reference
