Ask Question Forum:
Model Library:2025-02-08 Updated:A.I. model is online for auto reply question page
C
O
M
P
U
T
E
R
2
8
Show
#
ASK
RECENT
←
- Underline
- Bold
- Italic
- Indent
- Step
- Bullet
- Quote
- Cut
- Copy
- Paste
- Table
- Spelling
- Find & Replace
- Undo
- Redo
- Link
- Attach
- Clear
- Code
Below area will not be traslated by Google,you can input code or other languages
Hint:If find spelling error, You need to correct it,1 by 1 or ignore it (code area won't be checked).
X-position of the mouse cursor
Y-position of the mouse cursor
Y-position of the mouse cursor
Testcursor
caretPos
Attachment:===
Asked by duncanb7
at 2024-03-25 07:07:46
ModifyPoint:500 Replies:4 POST_ID:828449USER_ID:11059
Topic:
Microsoft Excel Spreadsheet Software;;Visual Basic Programming
I am trying to use Excel2003 VBA to capture a Window screen with its hwnd from the code provided at this website
http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/Windows/XP/Q_22959939.html?sfQueryTermInfo=1+10+30+captur+imag+screen+vba
And the code running is okay but when I step run it by (F8 press) and I found the VBA never going pass to
the code area at " If lColor = 14540253 Then" so there is no any bitBlt() and OpenClipboard() activate
Why it is set lcolor=1450253, what is that meaning ? I always get lcolor=-1 whatever x and y is
And I found it should set
For x = Rect.Left To Rect.Right
For y = Rect.Top To Rect.Bottom
Instead of
For x =0 To fheight-1
For y =0 To fwidth-1
]in order to locate exact position of the image to be captured, Even wth those change, I'm still not be able
to get the image to show me at Range("A1"). The image at Range("A1") is blank. Please advise any mistake I made and I would like to ask Two more question.
1- Why it is set 86,21 at BitBlt hDCmem2, 0, 0, 86, 21, hDCmem, x, y, SRCCOPY, what is that for
2- How can I save the image at clipboard to a file name as image.jpeg or image.bmp ?
Please advise
Duncan
http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/Windows/XP/Q_22959939.html?sfQueryTermInfo=1+10+30+captur+imag+screen+vba
And the code running is okay but when I step run it by (F8 press) and I found the VBA never going pass to
the code area at " If lColor = 14540253 Then" so there is no any bitBlt() and OpenClipboard() activate
Why it is set lcolor=1450253, what is that meaning ? I always get lcolor=-1 whatever x and y is
And I found it should set
For x = Rect.Left To Rect.Right
For y = Rect.Top To Rect.Bottom
Instead of
For x =0 To fheight-1
For y =0 To fwidth-1
]in order to locate exact position of the image to be captured, Even wth those change, I'm still not be able
to get the image to show me at Range("A1"). The image at Range("A1") is blank. Please advise any mistake I made and I would like to ask Two more question.
1- Why it is set 86,21 at BitBlt hDCmem2, 0, 0, 86, 21, hDCmem, x, y, SRCCOPY, what is that for
2- How can I save the image at clipboard to a file name as image.jpeg or image.bmp ?
Please advise
Duncan
Private Sub ScreenToClipBoard()Dim bHwnd As LongDim fwidth As LongDim fheight As LongDim hBitMap As LongDim hBitMap2 As LongDim hDC As LongDim hDCmem As LongDim hDCmem2 As LongDim lColor As LongDim junk As LongDim Rect As RectDim x As LongDim y As Long bHwnd = FindWindow(vbNullString, "Yahoo!-Windows Internet Explorer") ' Find Handle for IE If bHwnd = 0 Then MsgBox ("Did not find the Window with the title of:" & vbCrLf & vbCrLf & _ """" & """" & vbCrLf & vbCrLf & _ "Error number=" & Err.LastDllError) Exit Sub End If junk = SetForegroundWindow(bHwnd) ' Set this handle/Window as the Foreground Window. If junk = 0 Then ' A zero return code indicates failure MsgBox ("Unable to Set IE as the foreground Window.") Exit Sub End If '--------------------------------------------------- ' There will be some lag before this window is actually in the foreground, so, give it a ' little CPU to move it to the front DoEvents DoEvents DoEvents DoEvents DoEvents '--------------------------------------------------- ' Get screen coordinates of the browser window '--------------------------------------------------- Call GetWindowRect(bHwnd, Rect) fwidth = Rect.Right - Rect.Left ' Calculate Width of Window fheight = Rect.Bottom - Rect.Top ' Calculate Height of Window '--------------------------------------------------- ' Get a handle to the browser window '--------------------------------------------------- hDC = GetDC(bHwnd) ' Get 'Device Context' for IE window. '--------------------------------------------------- ' GetPixel only works if the hDC and the bitmap have been selected with SelectObject ' So, create a compatible bitmap and select it. '--------------------------------------------------- hDCmem = CreateCompatibleDC(hDC) hBitMap = CreateCompatibleBitmap(hDC, fwidth, fheight) ' Not sure if this should be before or after the SelectObject 'BitBlt hDCmem, 0, 0, fwidth, fheight, hDC, 0, 0, SRCCOPY If hBitMap <> 0 Then junk = SelectObject(hDCmem, hBitMap) If junk = 0 Then ' In my testing I always get a zero MsgBox ("Unable to SelectObject") ' See http://msdn2.microsoft.com/en-us/library/ms533272.aspx Exit Sub End If Else MsgBox "Could NOT create a memory bitmap" Exit Sub End If ' Not sure if this should be before or after the SelectObject BitBlt hDCmem, 0, 0, fwidth, fheight, hDC, 0, 0, SRCCOPY '---------------------------------------------------- ' Now create a hDC and bitmap for the final result bitmap. '---------------------------------------------------- hDCmem2 = CreateCompatibleDC(hDC) hBitMap2 = CreateCompatibleBitmap(hDC, 86, 21) '---------------------------------------------------- ' Search the browser window looking for the backcolor ' of the security code image '---------------------------------------------------- For x = 0 To fheight - 1 For y = 0 To fwidth - 1 lColor = GetPixel(hDCmem, x, y) If lColor = 14540253 Then '****************Problem is here, '--------------------------------------------- ' Once the security code is found, prepare to copy it ' to another memory resident bitmap '--------------------------------------------- If hBitMap2 <> 0 Then junk = SelectObject(hDCmem2, hBitMap2) Else MsgBox ("Could NOT create memory bitmap") Exit Sub End If BitBlt hDCmem2, 0, 0, 86, 21, hDCmem, x, y, SRCCOPY '--------------------------------------------- ' Set up the Clipboard and copy memory resident bitmap to it '--------------------------------------------- junk = OpenClipboard(bHwnd) junk = EmptyClipboard() junk = SetClipboardData(CF_BITMAP, hBitMap2) junk = CloseClipboard() '--------------------------------------------- ' Optionally, paste the clipboard contents into a cell on the spreadsheet '--------------------------------------------- Range("A1").Select ActiveSheet.Paste '--------------------------------------------- ' Clean up handles '--------------------------------------------- junk = DeleteObject(hBitMap) junk = DeleteObject(hBitMap2) junk = DeleteDC(hDCmem) junk = DeleteDC(hDCmem2) junk = ReleaseDC(bHwnd, hDC) End If Next y Next xStopEnd Sub 1:2:3:4:5:6:7:8:9:10:11:12:13:14:15:16:17:18:19:20:21:22:23:24:25:26:27:28:29:30:31:32:33:34:35:36:37:38:39:40:41:42:43:44:45:46:47:48:49:50:51:52:53:54:55:56:57:58:59:60:61:62:63:64:65:66:67:68:69:70:71:72:73:74:75:76:77:78:79:80:81:82:83:84:85:86:87:88:89:90:91:92:93:94:95:96:97:98:99:100:101:102:103:104:105:106:107:108:109:110:111:112:113:114:115:116:117:118:119:120:121:122:123:124:125:126:127:128:129:130:131:132:133:134:135:136:
Author: duncanb7 replied at 2024-03-25 09:27:27
Not sure I understand the question. You want to scan the picture for numbers, like character recognition? If so, that is not something I have done before, and not something I have seen done in VBA.
Expert: Erick37 replied at 2024-03-25 08:51:06
Not sure I understand the question. You want to scan the picture for numbers, like character recognition? If so, that is not something I have done before, and not something I have seen done in VBA.
Author: duncanb7 replied at 2024-03-25 08:44:14
Yes, you are correct, finally I complet to capture the whole window image and save it into file .
Another question, could I covert the image as text format, since image is number but in image jpeg or gif format.?
So I would like to detect the number in the image to do some VBA code controle. If the image can converted to
text 1,2,3,4 that will be easy to VBA code controls
For example, when the image number is 1 then go to function example in VBA ...Is it possible,
Thank
Duncan
Another question, could I covert the image as text format, since image is number but in image jpeg or gif format.?
So I would like to detect the number in the image to do some VBA code controle. If the image can converted to
text 1,2,3,4 that will be easy to VBA code controls
For example, when the image number is 1 then go to function example in VBA ...Is it possible,
Thank
Duncan
Function ScreenToClipBoard2()Dim ActiveHwnd As LongDim DeskHwnd As LongDim ForegroundHwnd As LongDim hdc As LongDim hdcMem As LongDim rect As rectDim junk As LongDim fwidth As Long, fheight As LongDim hBitmap As Long '--------------------------------------------------- ' Get window handle to Windows and Microsoft Access '--------------------------------------------------- DeskHwnd = GetDesktopWindow() ActiveHwnd = GetActiveWindow() ' ActiveHwnd = &H1D065C ActiveHwnd = &H1208E4 ForegroundHwnd = GetForegroundWindow() '--------------------------------------------------- ' Get screen coordinates of Active Window '--------------------------------------------------- Call GetWindowRect(ActiveHwnd, rect) ' or ' Call GetWindowRect(ForegroundHwnd, rect) fwidth = rect.Right - rect.Left fheight = rect.Bottom - rect.Top '--------------------------------------------------- ' Get the device context of Desktop and allocate memory '--------------------------------------------------- hdc = GetDC(DeskHwnd) hdcMem = CreateCompatibleDC(hdc) hBitmap = CreateCompatibleBitmap(hdc, fwidth, fheight) If hBitmap <> 0 Then junk = SelectObject(hdcMem, hBitmap) '--------------------------------------------- ' Copy the Desktop bitmap to memory location ' based on Microsoft Access coordinates. '--------------------------------------------- junk = BitBlt(hdcMem, 0, 0, fwidth, fheight, hdc, rect.Left, _ rect.Top, SRCCOPY) '--------------------------------------------- ' Set up the Clipboard and copy bitmap '--------------------------------------------- junk = OpenClipboard(DeskHwnd) junk = EmptyClipboard() junk = SetClipboardData(CF_BITMAP, hBitmap) ' Range("A1").Select 'ActiveSheet.Paste SaveSelectionAsBMP junk = CloseClipboard() End If '--------------------------------------------- ' Clean up handles '--------------------------------------------- junk = DeleteDC(hdcMem) junk = ReleaseDC(DeskHwnd, hdc)End Function Sub SaveSelectionAsBMP() Dim oImageIcon As CommandBarControl Dim intFaceId As Integer Dim IID_IDispatch As GUID Dim uPicinfo As uPicDesc Dim IPic As IPicture Dim hPtr As Long Dim FilePathName As Variant ' Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap strPictureFile = Application.GetSaveAsFilename("", "JPEG Files (*.jpeg), *.jpeg", , "Save as JPEG") If strPictureFile = "False" Then Exit Sub OpenClipboard 0 hPtr = GetClipboardData(CF_BITMAP) CloseClipboard 'Create the interface GUID for the picture With IID_IDispatch .Data1 = &H7BF80980 .Data2 = &HBF32 .Data3 = &H101A .Data4(0) = &H8B .Data4(1) = &HBB .Data4(2) = &H0 .Data4(3) = &HAA .Data4(4) = &H0 .Data4(5) = &H30 .Data4(6) = &HC .Data4(7) = &HAB End With ' Fill uPicInfo with necessary parts. With uPicinfo .Size = Len(uPicinfo) ' Length of structure. .Type = PICTYPE_BITMAP ' Type of Picture .hPic = hPtr ' Handle to image. .hPal = 0 ' Handle to palette (if bitmap). End With 'Create the Picture Object OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic 'Save Picture stdole.SavePicture IPic, strPictureFile 'fix the clipboard (it seems to go messed up) Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap End Sub 1:2:3:4:5:6:7:8:9:10:11:12:13:14:15:16:17:18:19:20:21:22:23:24:25:26:27:28:29:30:31:32:33:34:35:36:37:38:39:40:41:42:43:44:45:46:47:48:49:50:51:52:53:54:55:56:57:58:59:60:61:62:63:64:65:66:67:68:69:70:71:72:73:74:75:76:77:78:79:80:81:82:83:84:85:86:87:88:89:90:91:92:93:94:95:96:97:98:99:100:101:102:103:104:105:106:107:108:109:110:111:112:113:114:115:116:117:118:
Accepted Solution
Expert: Erick37 replied at 2024-03-25 08:28:44
500 points GOOD
It looks like the code you copied is looking for a specific region of the screen and is located by looking at the color of the pixels.
"If lColor = 1450253" is testing the pixel color for that exact color, which may not exist on the page you are looking at. The color -1 is white and 0 would be black. Try using 0 and you may see it working somewhat better. If you are looking to capture the entire screen, then the code you are looking at is not suitable.
Are you looking to save the whole IE window to file?
"If lColor = 1450253" is testing the pixel color for that exact color, which may not exist on the page you are looking at. The color -1 is white and 0 would be black. Try using 0 and you may see it working somewhat better. If you are looking to capture the entire screen, then the code you are looking at is not suitable.
Are you looking to save the whole IE window to file?
