Copy vùng dữ liệu và lưu lại dưới dạng hình ảnh

[levanduyet]

Chào các bạn,
Nếu các bạn sử dụng ASAP Ultilities chắc các bạn cũng biết tiện ích chuyển đổi vùng chọn thành hình ảnh. Tôi xin giới thiệu đoạn code sau để làm việc đó

Sub DoCamera()
    Dim MyPrompt As String
    Dim MyTitle As String
    Dim UserRange As Range
    Dim OutputRange As Range

    Application.ScreenUpdating = True

    'Yêu cầu người dùng chọn vùng'
    MyPrompt = "Xin chon vung ban muon chup."
    MyTitle = "Copy vung"
    On Error Resume Next
    Set UserRange = Application.InputBox(Prompt:=MyPrompt, _
        Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
    If UserRange Is Nothing Then End
    On Error GoTo 0

    'Copy vùng chọn vào Clipboard như hình ảnh'
    UserRange.CopyPicture

    'Prompt user for range to paste to'
    MyPrompt = "Xin chon vung ban muon dan ra ."
    MyTitle = "Copy vung"
    On Error Resume Next
    Set OutputRange = Application.InputBox(Prompt:=MyPrompt, _
        Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
    If OutputRange Is Nothing Then End
    On Error GoTo 0

    'Dán hình ra ngoài'
    OutputRange.PasteSpecial
    Selection.Formula = UserRange.Address
End Sub

Cũng hay hay...
Lê Văn Duyệt