Tuesday, March 6, 2012

SendKeys in VBA

To send text to Excel by using command in Excel marco (VBA), we can use method "SendKeys" to send it. SendKeys is a method to capture key strokes in VBA.

Syntax
expression .SendKeys(Keys, Wait)
expression A variable that represents an Application object.

NameRequired/OptionalData TypeDescription
KeysRequiredVariantThe key or key combination you want to send to the application, as text.
WaitOptionalVariantTrue to have Microsoft Excel wait for the keys to be processed before returning control to the macro. False (or omitted) to continue running the macro without waiting for the keys to be processed.
Key
Code
BACKSPACE
{BACKSPACE} or {BS}
BREAK
{BREAK}
CAPS LOCK
{CAPSLOCK}
CLEAR
{CLEAR}
DELETE or DEL
{DELETE} or {DEL}
DOWN ARROW
{DOWN}
END
{END}
ENTER (numeric keypad)
{ENTER}
ENTER
~ (tilde)
ESC
{ESCAPE} or {ESC}
HELP
{HELP}
HOME
{HOME}
INS
{INSERT}
LEFT ARROW
{LEFT}
NUM LOCK
{NUMLOCK}
PAGE DOWN
{PGDN}
PAGE UP
{PGUP}
RETURN
{RETURN}
RIGHT ARROW
{RIGHT}
SCROLL LOCK
{SCROLLLOCK}
TAB
{TAB}
UP ARROW
{UP}
F1 through F15
{F1} through {F15}

You can also specify keys combined with SHIFT and/or CTRL and/or ALT. To specify a key combined with another key or keys, use the following table.
To combine a key with
Precede the key code with
SHIFT
+ (plus sign)
CTRL
^ (caret)
ALT
% (percent sign)


Here is an example to use SendKeys

-------------------------------------------------------------------------------------------------------------------------
Sub Test()
   Application.SendKeys "{HOME}", True 'send HOME to the Excel and wait for the keys to be processed
   Application.SendKeys "Test" 'send word "Test" to the Excel with default value (without true/false) and not wait for the keys to be processed
End Sub
-------------------------------------------------------------------------------------------------------------------------

Wednesday, February 22, 2012

Example of mouse click by Excel VBA

This is an example to control mouse to click on the specify position by using Windows API function. First, declare the following in the code 

Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long


Const MOUSEEVENTF_LEFTDOWN As Integer = 2
Const MOUSEEVENTF_LEFTUP As Integer = 4
Const MOUSEEVENTF_RIGHTDOWN As Integer = 8
Const MOUSEEVENTF_RIGHTUP As Integer = 16


Private Type pointapi
    X  As Long

    Y  As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
------------------------------------------------------------------

Here is an example
Sub test()
   SetCursorPos 200, 200 'set mouse position at 200, 200
   Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) 'click left mouse
   Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) 'release left mouse

End Sub

Sunday, February 19, 2012

Convert dd:hh:mm:ss to hour or second


Public Function ConvertToHR(str As String) As String

'dd:hh:mm:ss
Dim d, h As Integer
Dim tmp, m, s As String

If str = "" Then
   ConvertToHR = "no data"
   Exit Function
End If
d = CInt(Mid(str, 1, 2))
h = CInt(Mid(str, 4, 2))
m = Mid(str, 7, 2)
s = Mid(str, 10, 2)
'tmp = CStr((d * 24) + h) & "." & m & "." & s
tmp = CStr((d * 24) + h)
ConvertToHR = tmp

End Function




Public Function ConvertToSec(str As String) As String
'dd:hh:mm:ss
Dim d, h As Long
Dim tmp, m, s As String

If str = "" Then
   ConvertToSec = "no data"
   Exit Function
End If
d = CInt(Mid(str, 1, 2))
h = CInt(Mid(str, 4, 2))
m = Mid(str, 7, 2)
s = Mid(str, 10, 2)
'tmp = CStr((d * 24) + h) & "." & m & "." & s
tmp = CStr((((d * 24) + h) * 60 + m) * 60 + s)
ConvertToSec = tmp

End Function

Friday, February 17, 2012

Array sorting procedure


'------------------------------------------------------------------------
Private Sub SortArray(arr() As Integer)
'------------------------------------------------------------------------
'This sub uses the Bubble Sort algorithm to sort an array of integers.

Dim lngX As Long
Dim lngY As Long
Dim tmp As Integer

For lngX = LBound(arr) To (UBound(arr) - 1)
   For lngY = LBound(arr) To (UBound(arr) - 1)
      If arr(lngY) > arr(lngY + 1) Then
         'exchange the items
         tmp = arr(lngY)
         arr(lngY) = arr(lngY + 1)
         arr(lngY + 1) = tmp
      End If
   Next lngY
Next lngX

End Sub






Tuesday, February 14, 2012

Key Enter in Excel VBA


To check the KeyPress event of "Enter" in user form.

A KeyPress event does not occur under the following conditions:
Pressing TAB.
Pressing ENTER.
Pressing an arrow key.
When a keystroke causes the focus to move from one control to another.
 
Therefore, if we would like to use an event Enter in Excel VBA, we should do as in the followings
 
---------------------------------------------------------------------------------------
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then 'we can use either 13 or vbKeyReturn
   MsgBox "This messagebox will show after press Enter!"
End If

End Sub
---------------------------------------------------------------------------------------


Below code is not working in Excel VBA
---------------------------------------------------------------------------------------

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If KeyAscii = 13 Then
   MsgBox "This procedure is not work for checking Enter event in Excel VBA!"
End If

End Sub
---------------------------------------------------------------------------------------

Monday, February 13, 2012

List files in specific path

Sub FileList()

'*** List all files in specific path and pattern ***'
'*** in Excel file start from cell A1 of sheet1 ***'
'*** using GetFileList and IsArray function ***'

Dim p As String
Dim X As Variant


p = "C:\test\*.xls" 'select only *.xls pattern
X = GetFileList(p)

Select Case IsArray(X)
   Case True 'files found
      'MsgBox UBound(x)
      Sheets("Sheet1").Range("A:A").Clear
      For i = LBound(X) To UBound(X)
         Sheets("Sheet1").Cells(i, 1).Value = X(i)
      Next i
   Case False 'no files found
      MsgBox "No matching files"
End Select


End Sub

Check existing value in array


Function InSArray(ByRef vArray() As String, ByVal vValue As String) As Boolean

'***Return true, if found this value in array***'
'***Return false, if not found this value in array***'

Dim i As Long


For i = LBound(vArray) To UBound(vArray)
   If vArray(i) = vValue Then
      InSArray = True
      Exit Function
   End If
Next i

InSArray = False

End Function