Rob,
The following works in a VB project. I haven't tried it in VBA, but maybe it
can get you close to what you are after. Paste the attached code in a module
and create a form named form1. Then create a sub to call the GetWindowBitMap
subr. It should capture the active window.
Good luck,
Wayne
Option Explicit
'Declare API to get a copy of entire screen
Public Declare Function BitBlt _
Lib "gdi32" ( _
ByVal hDestDC As Long, _
ByVal lngX As Long, ByVal lngY As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal lngXSrc As Long, ByVal lngYSrc As Long, _
ByVal dwRop As Long _
) As Long
'Declare API to get handle to screen
Public Declare Function GetDesktopWindow _
Lib "user32" () As Long
'Declare API to convert handle to device context
Public Declare Function GetDC _
Lib "user32" ( _
ByVal hwnd As Long _
) As Long
'Declare API to release device context
Public Declare Function ReleaseDC _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hdc As Long _
) As Long
'Declare API to get handle to the active window
Public Declare Function GetActiveWindow Lib "user32" () As Long
'Declare API to get boundries of the active window
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long,
lpRect As RECT) As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Sub GetWindowBitMap()
Dim lngX As Long
Dim lngY As Long
Dim lngXSrc As Long
Dim lngYSrc As Long
Dim dwRop As Long
Dim hwndSrc As Long
Dim hSrcDC As Long
Dim lngRes As Long
Dim lngM1 As Long
Dim lngM2 As Long
Dim lngN1 As Long
Dim lngN2 As Long
Dim lngPixelColor As Long
Dim lngPixelCount As Long
Dim lngRet As Long
Dim intPowerOfTwo As Integer
Dim recWindow As RECT
Dim TwipsPerPixelX As Single
Dim TwipsPerPixelY As Single
Dim NumPixX As Single
Dim NumPixY As Single
Form1.ScaleMode = vbPixels '3
dwRop = &HCC0020
hwndSrc = GetActiveWindow
' Get the rectangle describing the window
GetWindowRect hwndSrc, recWindow
'Set the values to translate the window from Pixels to Twips
NumPixX = Form1.ScaleWidth
NumPixY = Form1.ScaleHeight
'Set the ScaleMode to Twips
Form1.ScaleMode = 1
TwipsPerPixelX = Form1.ScaleWidth / NumPixX
TwipsPerPixelY = Form1.ScaleHeight / NumPixY
'Set the ScaleMode back to Pixels
Form1.ScaleMode = vbPixels '3
'Change the form size to the size of the Active Window
Form1.Move recWindow.Left * TwipsPerPixelX, _
recWindow.Top * TwipsPerPixelY, _
(recWindow.Right - recWindow.Left) * TwipsPerPixelX, _
(recWindow.Bottom - recWindow.Top) * TwipsPerPixelY
hSrcDC = GetDC(hwndSrc)
'Create the bitmap
lngRes = BitBlt(Form1.hdc, 0, 0, Form1.ScaleWidth, _
Form1.ScaleHeight, hSrcDC, 0, 0, dwRop)
'Release the Hardware Device Context to the Active Window
'Windows could hang if this is not done
lngRes = ReleaseDC(hwndSrc, hSrcDC)
'Display full size
Form1.Show
'Clear the clipboard
Clipboard.Clear
'Copy fhe form image to the clipboard
Clipboard.SetData Form1.Image, vbCFBitmap
End Sub
"Rob Starz" wrote in message
news:78E9190D508C8600499606E63AF0C4CB@in.WebX.maYIadrTaRb...
> I was curious to see if there is a way from VBA to do Print Screen like
> Alt+Print Screen.
>
> Is there a way.
>
> --
> Rob Starz
> Plogv 3.0 & 2000 (plot logging) for r14 & 2000
> ***Enhancement Tools for Arch. Desktop *****
> *** ADTcadPacX³ coming soon ****
> http://www.stardsign.com/main.htm
> StarDsign cad solution
>
>
>
>
