Chụp ảnh màn hình bằng VBA-Take Print screen

[vbano1]

Chúng ta gặp rắc rối khi mà màn hình cứ bị excel chèn vào khi chụp ảnh. Sau một hồi tìm kiếm vất vả, cuối cùng mình cũng kiếm được đoạn code để chụp ảnh màn hình và xuất ra trên máy tính.

'Declare Windows API Functions
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
'Declare Virtual Key Codes
Private Const VK_SNAPSHOT = &H2C
Private Const VK_KEYUP = &H2
Private Const VK_MENU = &H12
Public Const VK_TAB = &H9
Public Const VK_ENTER = &HD
 
Sub ScreenPrint() ' <= chay chuong trinh nay de chup anh
    'Press Alt + TAB Keys -- Step1
    Alt_Tab
 
    'Press Print Screen key using Windows API -- Step2.
    keybd_event VK_SNAPSHOT, 1, 0, 0 'Print Screen key down
    keybd_event VK_SNAPSHOT, 1, VK_KEYUP, 0 'Print key Up - Screenshot to Clipboard
 
    'Paste Image in Chart and Export it to Image file. -- Step3
    Charts.Add
    ThisWorkbook.Charts(1).AutoScaling = True
    ThisWorkbook.Charts(1).Paste
    ThisWorkbook.Charts(1).Export Filename:="E:\ClipBoardToPic.jpg", FilterName:="jpg" ' Image se duoc luu o trong o E. Ban co the sua link tuy y.
 
    'Supress warning message and Delete the Chart
    Application.DisplayAlerts = False
    ThisWorkbook.Charts(1).Delete
    Application.DisplayAlerts = True
 
 
End Sub
 
Sub Alt_Tab()
    DoEvents
    keybd_event VK_MENU, 1, 0, 0 'Alt key down
    DoEvents
    keybd_event VK_TAB, 0, 0, 0 'Tab key down
    DoEvents
    keybd_event VK_TAB, 1, VK_KEYUP, 0 'Tab key up
    DoEvents
    keybd_event VK_ENTER, 1, 0, 0 'Tab key down
    DoEvents
    keybd_event VK_ENTER, 1, VK_KEYUP, 0 'Tab key up
    DoEvents
    keybd_event VK_MENU, 1, VK_KEYUP, 0 'Alt key up
    DoEvents
End Sub

Nguồn:

Bạn cần đăng nhập để thấy link

 

[Euler]

Với code này thì cần xử lý một chút cho excel ẩn xuống:

Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
 bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2     ' key up
Private Const VK_SNAPSHOT = &H2C        ' print screen key
Private Const VK_MENU = &H12            ' alt key
Private Const VK_CONTROL = &H11         ' ctrl key
Sub ScreensCapture(vk)
    keybd_event vk, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 1
    keybd_event vk, 0, KEYEVENTF_KEYUP, 0
End Sub
Sub Window_Capture_VBA(Optional sTitle = "")
    Application.CutCopyMode = False

        AppActivate sTitle
        Application.Wait Now() + TimeValue("00:00:03")
        ScreensCapture VK_MENU
 
    Application.Wait Now() + TimeValue("00:00:03")
    Sheets("ss").Paste
    Application.CutCopyMode = False
End Sub

Sub testAll()
    Window_Capture_VBA          ' captures all screens
End Sub

Nguồn:

Bạn cần đăng nhập để thấy link

 

[tuhocvba]

Code này khi sử dụng thì ấn Alt+F8 hiện Dialog Box lên và chạy macro, có thể hạ excel xuống khi chụp ảnh.
Có hai thủ tục để chụp ảnh, mọi người từ từ tận hưởng. Code khá dài vì có cả comment chi tiết của tác giả, cho nên mình không post trực tiếp lên đây được. Qui định của diễn đàn là không post bài quá 10000 từ.
Link download:

http://www.mediafire.com/file/dyrac2v0mcyooa6/chup_anh_man_hinh.xlsm/file

Nguồn:

Bạn cần đăng nhập để thấy link