Vâng, mình cũng google cả tối, được mẩu code này nhưng không hài lòng lắm ạ.Chỉ dùng API thôi bạn. Gú gồ VBA screen capture
Option Explicit
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 VK_SNAPSHOT = &H2C
Sub PrintScreen()
keybd_event VK_SNAPSHOT, 1, 0, 0
ActiveSheet.Paste
End Sub
Cái tệ nhất là nó chỉ copy cái gì liên quan tới excel ấy.Hì hì, cách hay, nhưng copy nguyên màn hình rồi.
Google tiếp đi bạn
Nhưng bài 1 viếtNếu copy được nguyên màn hình mà không dính gì tới excel thì tốt ạ.
có cách nào để macro chụp ảnh một vùng cố định trên màn hình không ạ
Dạ, mục đích cuối cùng vẫn là chụp một vùng màn hình. Nhưng khả năng là khó, nên em tính chụp cả màn hình paste vô sheet. Rồi em tính toán cái vùng đó tương đương với range nào trên excel. Em chụp ảnh vùng range đó là ok. hơi cách rách nhưng có lẽ phải đi đường vòng ạ.Nhưng bài 1 viết
Vậy cuối cùng là copy cả màn hình hay chỉ 1 vùng trên màn hình?
Nếu là copy cả màn hình giống như khi không có Excel thì ẩn Excel đi. Đề phòng bạn không nói rõ tôi lưu ý. Nếu là copy Desktop không có Excel, không có cả mọi cửa sổ khác thì không ai lại ẩn (kéo xuống Taskbar) lần lượt mọi cửa sổ có thể có. Lúc này giả nhấn [Win]+[D] thôi. Bạn tự nhấn tổ hợp [Win]+[D] thì sẽ thấy Desktop "trần như nhộng".
Nhưng bạn vẫn chưa nói rõ. Bạn hiện thời có Excel chiếm toàn bộ màn hình. Nếu đồng nghiệp của bạn có Normal và Excel chiếm một tí, Notepad chiểm 1 tí, Paint chiếm một tí v...v Lúc này bạn cần chụp toàn bộ màn hình với các icons trên nó + Paint + Notepad, tức chỉ không có Excel hay màn hình nhưng không có Excel, Notepad, Paint?Dạ, mục đích cuối cùng vẫn là chụp một vùng màn hình. Nhưng khả năng là khó, nên em tính chụp cả màn hình paste vô sheet. Rồi em tính toán cái vùng đó tương đương với range nào trên excel. Em chụp ảnh vùng range đó là ok. hơi cách rách nhưng có lẽ phải đi đường vòng ạ.
Về vấn đề chụp cả màn hình dán vào excel thì em vẫn chưa làm dc ạ.
Đoạn code này nó chụp được đây anh.Nhưng bạn vẫn chưa nói rõ. Bạn hiện thời có Excel chiếm toàn bộ màn hình. Nếu đồng nghiệp của bạn có Normal và Excel chiếm một tí, Notepad chiểm 1 tí, Paint chiếm một tí v...v Lúc này bạn cần chụp toàn bộ màn hình với các icons trên nó + Paint + Notepad, tức chỉ không có Excel hay màn hình nhưng không có Excel, Notepad, Paint?
Thường người ta viết code cho trường hợp tổng quát chứ không ai lại giả sử là Excel chiếm toàn bộ màn hì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
'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
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
'https://officetricks.com/print-screen-save-as-image-file-attach-to-sheet-automate-in-vba/
không thao tác được với sheet là sao bạn mình thấy bình thường màĐoạn code này nó chụp được đây anh.
Sau khi chạy code xong, anh vào paint và ấn ctr+V.Mã:'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 '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 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 'https://officetricks.com/print-screen-save-as-image-file-attach-to-sheet-automate-in-vba/
Em ko lý giải nổi là tại sao khi chạy code xong thì ko thao tác được với sheet excel nữa.
uh cảm ơn bạn. giờ tớ cũng thấy bình thường rồikhông thao tác được với sheet là sao bạn mình thấy bình thường mà
Tôi có nói là việc của bạn không làm được đâu?Đoạn code này nó chụp được đây anh.
Option Explicit
Private Const VK_LWIN = 91
Private Const VK_D = 68
Private Const KEYEVENTF_KEYUP = 2
Private Const SRCCOPY As Long = &HCC0020
Private Const CF_BITMAP = 2
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Sub PrintScreen()
Const left = 200
Const top = 200
Const width = 500
Const height = 200
Dim DC As Long, destDC As Long, hbmp As Long, oldbmp As Long
keybd_event VK_LWIN, 0, 0, 0
keybd_event VK_D, 0, 0, 0
keybd_event VK_LWIN, 0, KEYEVENTF_KEYUP, 0
Application.Wait Now + TimeValue("0:00:05")
DC = GetDC(0)
destDC = CreateCompatibleDC(DC)
hbmp = CreateCompatibleBitmap(DC, width, height)
oldbmp = SelectObject(destDC, hbmp)
BitBlt destDC, 0, 0, width, height, DC, left, top, SRCCOPY
SelectObject destDC, oldbmp
DeleteDC destDC
ReleaseDC 0, DC
OpenClipboard 0
EmptyClipboard
SetClipboardData CF_BITMAP, hbmp
CloseClipboard
DeleteObject hbmp
ActiveSheet.Paste
End Sub
Dạ, mục đích cuối cùng vẫn là chụp một vùng màn hình. Nhưng khả năng là khó, nên em tính chụp cả màn hình paste vô sheet. Rồi em tính toán cái vùng đó tương đương với range nào trên excel. Em chụp ảnh vùng range đó là ok. hơi cách rách nhưng có lẽ phải đi đường vòng ạ.
Về vấn đề chụp cả màn hình dán vào excel thì em vẫn chưa làm dc ạ.
Nhưng bài 1 viết
Vậy cuối cùng là copy cả màn hình hay chỉ 1 vùng trên màn hình?
Nếu là copy cả màn hình giống như khi không có Excel thì ẩn Excel đi. Đề phòng bạn không nói rõ tôi lưu ý. Nếu là copy Desktop không có Excel, không có cả mọi cửa sổ khác thì không ai lại ẩn (kéo xuống Taskbar) lần lượt mọi cửa sổ có thể có. Lúc này giả nhấn [Win]+[D] thôi. Bạn tự nhấn tổ hợp [Win]+[D] thì sẽ thấy Desktop "trần như nhộng".
Tôi không hiểu ý. Đã cho vùng thì copy vùng đó thôi, Height để làm gì?Thật ko ngờ VBA có thể chụp được màn hình
1.Nhờ bác làm giúp mình đoạn code mà khi mình gõ vùng chụp vào B1 (hoặc quét chổi vùng chụp) và độ cao của hình thì tự nó chụp rồi xuất ảnh vào định dạng theo chiều cao trong sheet 1 đó luôn.
Mình gửi file đính kèm như là ví dụ.
Sub test()
With ThisWorkbook.Worksheets("Sheet1")
.Range(.Range("B1").Value).CopyPicture
' .Range("Q7").Select
.Paste
End With
End Sub
Tôi viết rõ mà2. Sẵn tiện cho mình hỏi sao code của bác mình bị báo lỗi? mình có để ảnh trong sheet 2 để bác xem sao có đoạn code báo đỏ.
Code chỉ viết cho 32 bit.
để tự nó co giãn, mình copy hình đó bỏ vào power point luôn mà không cần căn chỉnh lại nữa. Nhưng code bác cho mình dùng cũng ổn. Cơ mà sao nó format khác cách dùng của snipping nhỉ? nó bị đậm lên 2 đường này nè bác. Mình muốn nó y như format gốc đó ạTôi không hiểu ý. Đã cho vùng thì copy vùng đó thôi, Height để làm gì?