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

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

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

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
---------------------------------------------------------------------------------------

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

Get user name function

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
---------------------------------------------------------

Public Function CurrentUser() As String
'*********************************************************
'* Function to get the current logged on user in windows *
'*********************************************************


Dim strBuff As String * 255
Dim X As Long

CurrentUser = ""
X = GetUserName(strBuff, Len(strBuff) - 1)
If X > 0 Then
   'Look for Null Character, usually included
   X = InStr(strBuff, vbNullChar)
   'Trim off buffered spaces too
   If X > 0 Then
      CurrentUser = UCase(Left$(strBuff, X - 1)) 'UCase is optional
   Else
      CurrentUser = UCase(Left$(strBuff, X))
   End If
End If


End Function

GetFileSize function

Function GetFileSize(folderspec As String) As Variant

'   Returns an array of file size that match FileSpec

    Dim fs, f, f1, fc, s

    Dim FileArray() As Variant

    Dim FileCount As Integer

    Dim filesize As String

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set f = fs.GetFolder(folderspec)

    Set fc = f.Files

    FileCount = 0

    For Each f1 In fc

        s = f1.Size

        filesize = s

        FileCount = FileCount + 1

        ReDim Preserve FileArray(1 To FileCount)

        FileArray(FileCount) = filesize

        GetFileSize = FileArray

    Next

End Function

GetFileList function

Function GetFileList(filespec As String) As Variant
'***Function to get list of files in specific folder***'
' Returns an array of file names that match FileSpec

' If no matching files are found, it returns False

Dim FileArray() As Variant

Dim FileCount As Integer

Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0

FileName = Dir(filespec)

If FileName = "" Then GoTo NoFilesFound

' Loop until no more matching files are found

Do While FileName <> ""

   FileCount = FileCount + 1

   ReDim Preserve FileArray(1 To FileCount)

   FileArray(FileCount) = FileName

   FileName = Dir()

Loop

GetFileList = FileArray

Exit Function

' Error handler

NoFilesFound:

GetFileList = False

End Function

Excel VBA command (4)

Calculation

Command	Description
Application.Calculation = xlManual	Set calculation option to Manual (by F9)
Application.Calculation = xlAutomatic	Set calculation option to Automatic
Activesheet.Calculate	Calculate on activesheet only

CutCopyMode

Command	Description
Application.CutCopyMode=False	Clear data in clip board

Quit

Command	Description
Application.Quit	Quit Excel

ScreenUpdating

Command	Description
Application.ScreenUpdating = False	Result of commands between both will not display on screen
Application.ScreenUpdating = True

StatusBar

Command	Description
Application.DisplayStatusBar = False	Not display status bar
Application.DisplayStatusBar = True	Display status bar
Application.StatusBar = "Test"	Set to show "Test" on status bar

DisplayAlert

Command	Description
Application.DisplayAlerts = False	Not display any alert such as dialog box
Application.DisplayAlerts = True	Display alert

Excel VBA command (3)

Workbook

Command	Description
1. Workbooks.Open "Book1.xls"	Open "Book1.xls"
2. Workbooks.Open Sheets("Sheet1").Range("A1").Value	Open file by referring to file name in cell "A1" of "Sheet1"
3. Workbooks.Open Filename:= "C:\Book1.xls"	Open "C:\Book1.xls"
4. ThisWorkbook.Close	Close workbook which is coded
5. Workbooks("Book1.xls").Close	Close file "Book1.xls"
6. Workbooks(Range("A1").Value).Close	Close file by referring to file name in cell "A1"
7. ActiveWorkbook.Save	Save active workbook
8. Workbooks("Book1.xls").Save	Save "Book1.xls"
9. Workbooks(Range("A1").Value).Save	Save file by referring to file name in cell "A1"
10. ActiveWorkbook.SaveAs "C:\Book1.xls"	SaveAs active workbook to "C:\Book1.xls"
11. Workbooks("Book1.xls").SaveAs "C:\Book1.xls"	SaveAs "Book1.xls" to "C:\Book1.xls"
12. Workbooks(1).Close SaveChanges:=False	Close workbook index 1 without save
13. Workbooks(1).Close SaveChanges:=True	Close workbook index 1 with save
14. Kill "C:\Book1.xls"	Kill file "C:\Book1.xls"
15. Workbooks.Add	Add new workbook
16. ActiveWorkbook.Name	Return name of active workbook
17. Difference between ThisWorkBook and ActiveWorkBook	ThisWorkBook object refers to the workbook that the code is contained in ActiveWorkBook object refers to the workbook that is currently on top (Active) in Excel