Hỏi về cách in ấn trong Excel

[ThangAcc]

Tôi có 1 bảng như thế này (Bảng 1):

http://i139.photobucket.com/albums/q319/ThangAcc/Bang1.jpg
Bây giờ tôi muốn in một đoạn (Tôi chọn một vùng và dùng print selection), giả sử tôi in vùng như vùng đánh dấu dưới đây (Bảng 2):

http://i139.photobucket.com/albums/q319/ThangAcc/Bang2.jpg
Khi tôi chọn vùng đó và dùng Print selection, máy in sẽ in ra như thế này (Bảng 3):

http://i139.photobucket.com/albums/q319/ThangAcc/Bang3.jpg
Vấn đề bây giờ là làm thế nào để máy in vẫn in ra tại vị trí tôi đã chọn, tức là nó phải in ra thế này (Bảng 4):

http://i139.photobucket.com/albums/q319/ThangAcc/Bang4.jpg
Mong mọi người giúp đỡ.

 

[ThangAcc]

Em đã sửa lại rồi, không biết đã được chưa, mong các bác chỉ giáo

Thanks bác, bây giờ em mới biết dùng Photobucket.

 

[Đào Việt Cường]

Dear all,
--------
Mình thấy, đưa được cái hình minh hoạ như ở trên chính ThangAcc đã đưa ra 1 giải pháp rồi!

 

[nvson]

Sau vài hồi "ngâm cứu" mới ra được đôi chút.
Bạn thử code sau nhé!

Sub Print_Selection()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim page_1 As Boolean
page_1 = False
Dim rngData As Range
Set rngData = Selection
Dim shtPrint As Worksheet
Cells.Select
Selection.Copy
Set shtPrint = Sheets.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
   
rngData.Copy
shtPrint.Range(rngData.Address).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
shtPrint.Range(rngData.Address).Select
'Bat dau xu ly In an
Dim i
ActiveWindow.View = xlPageBreakPreview
i = ActiveCell.Row
Do
    i = i - 1
    If Rows(i).PageBreak = xlPageBreakAutomatic Then
        page_1 = True
        Exit Do
    End If
Loop While i > 1
If page_1 Then
    Range("1:" & i - 1).Select
    Selection.EntireRow.Hidden = True
End If
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
shtPrint.Delete
Set shtPrint = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Cách sử dụng:
Chọn vùng cần in, rồi chạy macro trên.

 

[ThangAcc]

Cái vùng cần in trên chỉ là cái ảnh thôi các bác ạ, chứ không in lên trang giấy thật được như thế.

 

[ThangAcc]

Cái macro vẫn chưa được bác NVSON ạ, tôi post lên file excel để các bác tham khảo.
Các bác có thể làm thế nào để có thể chọn máy in và preview trước khi in được không? Thanks các bác.

 

[nvson]

Hy vọng macro sau sẽ giúp được cho bạn.
Nhưng chú ý là bạn phải bỏ định dạng căn lề Center on Page đi thì mới giống nhau được.
Cách sử dụng:
Chọn vùng cần in rồi chạy macro.

 

[ThangAcc]

Nó báo lỗi bác NVSON ạ

 

[nvson]

Mình chạy có sao đâu nhỉ?
Mình làm trên MS Excel 2003.
Bạn thử nhấn vào chữ Debug xem nó báo lỗi ở dòng nào nhé!

 

[ThuNghi]

Sao A NVSON không làm thủ tục theo hướng như sau có vẻ đơn giản hơn (I think so)
- Đặt mảng cần in và khóa lại
- Chọn hết cho chữ và outline màu trắng hay đại lọai
- In bình thường, cùng lắm thêm thông số in Draft

 

[nvson]

Nếu bạn đọc code thì thuật toán cũng "gần" tương tự như vậy. Nhưng mình muốn xử lý thêm là không có page trống.

 

[ThangAcc]

Nó báo lỗi thế này bác ạ

Em dùng Office 2000 mà không muốn cài 2003.

 

[nvson]

Bạn có thể bỏ dòng lệnh đó đi cũng được mà!

 

[ThangAcc]

Sao A NVSON không làm thủ tục theo hướng như sau có vẻ đơn giản hơn (I think so)
- Đặt mảng cần in và khóa lại
- Chọn hết cho chữ và outline màu trắng hay đại lọai
- In bình thường, cùng lắm thêm thông số in Draft

Đúng là nếu có cách nào khác nhanh hơn thì hay.

 

[nvson]

Vậy bạn dùng thử code sau:

Sub Print_Selection2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim page_1 As Boolean
page_1 = False
Dim shtActivate As Worksheet
Set shtActivate = ActiveSheet
Dim rngData As Range
Set rngData = Selection
Dim shtPrint As Worksheet
shtActivate.Copy After:=shtActivate
Set shtPrint = ActiveSheet
Cells.Select
With Selection
    .ClearContents
    
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    
    .Interior.ColorIndex = xlNone
    
End With
   
rngData.Copy
shtPrint.Range(rngData.Address).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
shtPrint.Range(rngData.Address).Value = rngData.Value
shtPrint.Range(rngData.Address).Select
'Den day co ban la xong, ban co the xoa nhung dong duoi di cung duoc
'Exit Sub
'Bat dau xu ly In an
Dim i, row1, col1
ActiveWindow.View = xlPageBreakPreview
row1 = ActiveCell.Row
col1 = ActiveCell.Column
For i = row1 To 1 Step -1
    If Rows(i).PageBreak = xlPageBreakAutomatic Then
        page_1 = True
        Exit For
    End If
Next i
If page_1 Then
    Range("1:" & i - 1).Select
    Selection.EntireRow.Hidden = True
End If
page_1 = False
For i = col1 To 1 Step -1
    If Columns(i).PageBreak = xlPageBreakAutomatic Then
        page_1 = True
        Exit For
    End If
Next i
If page_1 Then
    Range("A1:" & Cells(1, i - 1).Address).Select
    Selection.EntireColumn.Hidden = True
End If
Dim Ans
Ans = MsgBox("Ban co muon Preview khong?", vbQuestion + vbYesNo)
If Ans = 6 Then
    ActiveWindow.SelectedSheets.PrintPreview
Else
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
Ans = MsgBox("Ban co muon xoa sheet tam thoi nay khong?", vbQuestion + vbYesNo)
If Ans = 6 Then
    shtPrint.Delete
    Set shtPrint = Nothing
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[edu8]

Theo tôi bạn có thể làm cách thủ công này cũng được. Bạn đặt khổ giấy dài hơn bình thường và đặt lề trên bằng 10 cm. khi in bạn sẽ được như ý