** PLEASE DO NOT REPLY TO THIS MESSAGE **
If you do have queries they will be better in separate messages dealing with just the bit you need.
Keywords : API CALLS, SENDKEYS, PRINT SCREEN, EXTERNAL APPLICATIONS
I am currently using CD writing software which has a dialog for track settings. The equaliser settings are visual, so would be difficult to record manually. With up to 30 tracks to a CD I need an automatic method of copying screen shots into Excel.
To make programming easier at this early stage I use Windows Calculator as the external application. I have also put more subroutines than usual to keep the thing clearer - and knowing I might not need some of them later.
The code below doesn't do much with Calculator, but does include almost everything needed (perhaps more) for a project like this - and does work on my PC. A big problem with running external applications is that the macro runs too fast, and does not allow time for things to happen on screen. eg when manipulating a menu with SendKeys. To overcome this there are a couple of ways of putting delays in the code. There is then the need to balance overall runtime with accuracy. Running such code on a server gives huge problems with variable speeds depending on "traffic" at the time.
It is not possible to do a screenshot using SendKeys. The API code for this does the same job by mimicing Alt + PrintScreen keypresses. Generally I have found the API method of mimicing keystrokes more reliable than SendKeys but it needs more work - such as by requiring separate KeyUp and KeyDown commands.
Just a mention - it is possible to mimic Mouse activity using API. Luckily it is not necessary here. If you think using keystrokes is complicated .......... !!!
Hope some of you find this useful.
If you do have queries they will be better in separate messages dealing with just the bit you need.
Keywords : API CALLS, SENDKEYS, PRINT SCREEN, EXTERNAL APPLICATIONS
I am currently using CD writing software which has a dialog for track settings. The equaliser settings are visual, so would be difficult to record manually. With up to 30 tracks to a CD I need an automatic method of copying screen shots into Excel.
To make programming easier at this early stage I use Windows Calculator as the external application. I have also put more subroutines than usual to keep the thing clearer - and knowing I might not need some of them later.
The code below doesn't do much with Calculator, but does include almost everything needed (perhaps more) for a project like this - and does work on my PC. A big problem with running external applications is that the macro runs too fast, and does not allow time for things to happen on screen. eg when manipulating a menu with SendKeys. To overcome this there are a couple of ways of putting delays in the code. There is then the need to balance overall runtime with accuracy. Running such code on a server gives huge problems with variable speeds depending on "traffic" at the time.
It is not possible to do a screenshot using SendKeys. The API code for this does the same job by mimicing Alt + PrintScreen keypresses. Generally I have found the API method of mimicing keystrokes more reliable than SendKeys but it needs more work - such as by requiring separate KeyUp and KeyDown commands.
Just a mention - it is possible to mimic Mouse activity using API. Luckily it is not necessary here. If you think using keystrokes is complicated .......... !!!
Hope some of you find this useful.
Code:
'======================================================================
'- MACRO TO RUN PRINT SCREEN MULTIPLE TIMES ON AN EXTERNAL APPLICATION
'- AND PASTE PICTURES INTO A WORKSHEET
'- Needs a range named 'Gallery' in the active sheet - 1 cell per picture.
'- Check path to Calculator in code below
'- Brian Baulsom September 2005
'======================================================================
'- API to get window handle by using the name
Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" (ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As Long
'-------------------------------------------------------------------------
'- API to bring window to top
Declare Function BringWindowToTop Lib "user32.dll" _
(ByVal hwnd As Long) As Long
'--------------------------------------------------------------------------
'- API to get handle of the active window (no need to know its name)
Declare Function M_GetActiveWindow Lib "user32" _
Alias "GetActiveWindow" () As Long
'--------------------------------------------------------------------------
'- API to get window caption (my app. changes the dialog caption/name)
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
(ByVal hWnd As Long) As Long
'---------------------------------------------------------------------------
'- API used to to print screen (mimics keystrokes). Cannot use SendKeys.
Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const VK_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
'==========================================================================
'- general
Dim ExcelWindowName As String
Dim ExcelHandle As Long
Dim ws As Worksheet
Dim PictureGallery As Range
Dim WindowHandle As Long ' Windows window ID
Dim WindowName As String ' Window Caption (Case sensitive)
Dim PictureNumber As Integer
Dim PictureCell As Range
Dim PictureSet As ShapeRange
Dim rsp As Variant
'--------------------------------------------------------------------------
'- SendKeys
Dim EscapeKey As String
Dim AltKey As String
Dim CtrlKey As String
Dim ShiftKey As String
Dim TabKey As String
Dim EnterKey As String
Dim UpKey As String
'===========================================================================
'===========================================================================
'- MAIN ROUTINE
'===========================================================================
Sub MAIN()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'- get Excel API info
ExcelWindowName = Application.Caption
ExcelHandle = M_GetActiveWindow()
PictureNumber=1
'----------------------------------------------------------------------
'- need to know original window name of external application
WindowName = "Calculator"
Initialise
ws.Range("A1").Select ' remove focus from button on sheet
'======================================================================
'- manipulate external application
'======================================================================
Get_Window ' activate Calculator window
'-------------------------------------------
SendKeys EscapeKey, True ' clear total
For p = 1 To 3
SendKeys "2", True
DoEvents
SendKeys "{+}", True
DoEvents
Application.Wait Now + TimeValue("00:00:01") ' WAIT 1 SECOND
Print_Screen
Next
'=====================================================================
'- finish - bring Excel to the top
rsp = BringWindowToTop(ExcelHandle)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox ("Done")
End Sub
'== EOP ====================================================================
'===========================================================================
'- FUNCTION TO GET ACTIVE WINDOW CAPTION
'- ** can use VBA ActiveWindow.Caption instead for Excel ******
' This does not seem to work with Calculator or some other applications
'===========================================================================
Private Function ActiveWindowCaption() As String
Dim MyCaption As String
Dim MyLen As Long
Dim hWnd As Long
'-------------------------
hWnd = M_GetActiveWindow()
MyCaption = String(GetWindowTextLength(hWnd) + 1, Chr$(0))
GetWindowText hWnd, MyCaption, Len(MyCaption)
ActiveWindowCaption = MyCaption
End Function
'=====================================================================
'- INITIALISE
'=====================================================================
Private Sub Initialise()
Set ws = ActiveSheet
WindowHandle = 0
'---------------------------------------
'- SendKeys
EscapeKey = "{ESCAPE}"
AltKey = "%"
CtrlKey = "^"
ShiftKey = "+"
TabKey = "{TAB}"
EnterKey = "~"
UpKey = "{UP}"
'----------------------------------------------------------------
Set PictureGallery = ws.Range("A1:H50")
PictureGallery.Rows.RowHeight = 70
PictureGallery.Columns.ColumnWidth = 15
'---------------------------------------------------
On Error Resume Next ' might be no existing pictures
Set PictureSet = ws.Pictures.ShapeRange
PictureNumber = PictureSet.Count + 1
End Sub
'=====================================================================
'- PRINT SCREEN & PASTE INTO THE WORKSHEET
'- events and SendKeys work slowly, so need lots of delays in the code
'- EDIT - Since adding DoEvents I have been able to comment some of them out
'=====================================================================
Private Sub Print_Screen()
'- API print screen
keybd_event VK_MENU, 0, 0, 0 ' Alt key down
DoEvents
keybd_event VK_SNAPSHOT, 0, 0, 0 ' PrintScreen key down
DoEvents
keybd_event VK_SNAPSHOT, 0, VK_KEYUP, 0
DoEvents
keybd_event VK_MENU, 0, VK_KEYUP, 0
DoEvents
'Application.Wait Now + TimeValue("00:00:01") ' WAIT 1 SECOND
'---------------------------------------------------------------
'- paste picture to worksheet
Set PictureCell = PictureGallery.Cells(PictureNumber)
ws.Paste Destination:=PictureCell
DoEvents
'Application.Wait Now + TimeValue("00:00:01") ' WAIT 1 SECOND
Set PictureSet = ws.Pictures.ShapeRange
'---------------------------------------------------------------
'- format new picture
With PictureSet(PictureNumber)
.Top = PictureCell.Top
.Left = PictureCell.Left
.LockAspectRatio = msoFalse
.Height = 70#
.Width = 70#
.Placement = xlFreeFloating
End With
'Application.Wait Now + TimeValue("00:00:01")
'----------------------------------------------------------------
PictureNumber = PictureNumber + 1
End Sub
'=====================================================================
'- GET WINDOW TO TOP
'- record the original handle because the application window caption changes
'=====================================================================
Private Sub Get_Window()
'-----------------------------------------------------------------
' Initial check for open window
If WindowHandle = 0 Then
WindowHandle = FindWindow(CLng(0), WindowName)
End If
'------------------------------------------------------------------
'- If handle is still zero window name was not found
If WindowHandle = 0 Then
RunCalculator
'rsp = MsgBox("There is no window called " & WindowName, vbOKOnly + vbCritical, " NO WINDOW")
WindowName = ActiveWindowCaption
WindowHandle = M_GetActiveWindow() ' get active window handle
Else
rsp = BringWindowToTop(WindowHandle)
End If
End Sub
'====================================================================
'- RUN CALCULATOR
'====================================================================
Private Sub RunCalculator()
x = Shell("C:\Calc.exe", 1)
WindowHandle = FindWindow(CLng(0), WindowName)
rsp = BringWindowToTop(WindowHandle)
End Sub
