In nhiều lựa chọn trên một trang tính bằng VBA trong Microsoft Excel
Nếu bạn chọn nhiều phạm vi ô trên một trang tính và cố gắng in ra các ô đã chọn, bạn sẽ nhận được một trang tính cho mỗi vùng đã chọn.
Macro ví dụ sau sẽ in tất cả các vùng đã chọn trên một trang tính, ngoại trừ trường hợp các vùng đó quá lớn để vừa trong một trang tính.
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