Solved: Save as picture

[Marcster]

Hi all,

I'm trying to get a macro that will take a screenshot of the
user's desktop and save it as a picture file to a folder say
C:\Scrns
So far have:
WordBasic.SendKeys "{prtsc}"
which takes the screenshot and puts it on the Clipboard.
Now I need this to be saved as a picture to the folder.
Thought maybe pasting the picture to a new document then saving as..
But in Word there's no save as picture.
I'm using Word 2000.
Any ideas?.
Thanks,

Marcster.

[Killian]

Hi Marc

I was thinking about your post for this in Excel and had worked something out using the Office automation IPictureDisp class and since you now want the same in Word...

I had been trying to do a similar thing but was having problems depending on what was on the clipboard - however, for printscreen, we know we'll definately have a bitmap, so I've stripped out the surplus bits and it seems to work nicely.

It looks like a lot of code, but because it's using Win API functions, it's very quick and best of all, works in any Office app '##############################################
'### Paste into a standard module - call Clip2File ###
'##################################################

' Checks the clipboard for a bitmap
' If found, creates a standard Picture object from the
' clipboard contetnts and saves it to a file

' The code requires a reference to the "OLE Automation" type library

' The code in this module has been derived primarily from _
' the PatsePicture sample on Stephen Bullen's Excel Page _
' - http://www.bmsltd.ie/Excel/Default.htm

'Windows API Function Declarations
Private Declare Function IsClipboardFormatAvailable Lib "user32" _
(ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle _
As Long, IPic As IPicture) As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle _
As Long, _
ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, _
ByVal un2 As Long) As Long

'The API format types we need
Const CF_BITMAP = 2
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4


'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

'Declare a UDT to store the bitmap information
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Sub Clip2File()

Dim strOutputPath As String, oPic As IPictureDisp

'Get the filename to save the bitmap to
strOutputPath = Environ("TEMP") & "\temp.bmp"

'Retrieve the picture from the clipboard...
Set oPic = GetClipPicture()

'... and save it to the file
If Not oPic Is Nothing Then
SavePicture oPic, strOutputPath
MsgBox "File saved: " & strOutputPath
Else
MsgBox "Unable to retrieve bitmap from clipboard"
End If
End Sub

Function GetClipPicture() As IPicture

Dim h As Long, hPicAvail As Long, hPtr As Long, _
hPal As Long, hCopy As Long

'Check if the clipboard contains a bitmap
hPicAvail = IsClipboardFormatAvailable(CF_BITMAP)

If hPicAvail <> 0 Then
'Get access to the clipboard
h = OpenClipboard(0&)
If h > 0 Then
'Get a handle to the image data
hPtr = GetClipboardData(CF_BITMAP)
hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
'Release the clipboard to other programs
h = CloseClipboard
'If we got a handle to the image, convert it into _
'a Picture object and return it
If hPtr <> 0 Then Set GetClipPicture = CreatePicture(hCopy, _
0, CF_BITMAP)
End If
End If

End Function

Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, _
ByVal lPicType) As IPicture

' IPicture requires a reference to "OLE Automation"
Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, _
IPic As IPicture

'OLE Picture types
Const PICTYPE_BITMAP = 1

' Create the Interface GUID (for the IPicture interface)
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 = hPic ' Handle to image.
.hPal = 0 ' Handle to palette (if bitmap).
End With

' Create the Picture object.
r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)

' Return the new Picture object.
Set CreatePicture = IPic

End Function

[fumei]

arrgghhh, would like to be able to see this code. What size monitor are you guys using and at what resolution???

Underscore character, for example:
Private Function CreatePicture(ByVal hPic As Long, _
ByVal hPal As Long, ByVal lPicType) As IPicture
would it much easier for the rest of us.

Please? It is not all that difficult to use. I know it takes a bit of getting used to, but gee....

[Killian]

arrgghhh, would like to be able to see this code. What size monitor are you guys using and at what resolution???...

...Please? It is not all that difficult to use. I know it takes a bit of getting used to, but gee....
Hi Gerry :hi:
Well 1280x1024 is my preference, but I take what I can get...
However, distressed at the prospect that my thoughtlessness may be adversly effecting someone elses stress levels, I'm now setting myself a strict character limit of 64 per line from this point forward - I've even stuck a post-it to that effect on the edge of my monitor, which is the programmers equivalent of a constitutional amendment.
I haven't quite decided on a penalty for infringements yet, but rest-assured it will be fair but firm :whip

[fumei]

Hi K, thank you!!!!! I was surprised, and delighted to see that you actually went back and edited it. Ahhhhhhhhhhh, I can read it.

It is not really thoughtlessness. It is simply that most people looking at THEIR monitor (at high resolution) get used to it and simply forget that other do not share this configuration. It is common to think that if it is working for me...it is working for everyone. For we all think we are the centre of the universe.

A post-it? Whoa, you are serious. That IS like a constitutional amendment.

Much appreciated. I know I have been harping for some time on this, in a number of threads. Sorry if I have been a pain. Training people is such a chore......

It would not be so bad if the code window was larger, but it is not, and there ya go. All in all it is just a good idea anyway. If you look in MS Help, or even MSDN quite often they make every argument of a Sub its own line - even if it is less than 64 characters. It makes things easier to read even in a VBE window.

Thanks again.

[Marcster]

Thanks K :beerchug:,
Works great :thumb.
Just wondering if you knew of an API
which takes a screenshot of the whole
screen and one which captures
only the active window? :dunno .

Marcster.

[Marcster]

I've just found this on MSDN:
http://support.microsoft.com/default.aspx?scid=kb;en-us;240653

Working my way through it :coffee: , I'll post how I get on later.

Marcster.

[Marcster]

Yey, got it working :joy:.

Marcster.