I set up my own library with functions and subs for VBA (Word) and wanted to create a new class module. But I can't figure out how to use this new class with other files.
StopWatch Example (Normal.dotm, Class module: Global_StopWatch)
Private mlngStart As Long
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Public Sub StartTimer()
mlngStart = GetTickCount
End Sub
Public Function EndTimer() As Long
EndTimer = (GetTickCount - mlngStart)
End Function
StopWatch call (Document.dotm, module: Test)
Sub swTest()
Dim gSW As Global_StopWatch
Set gSW = New Global_StopWatch
gSW.StartTimer
Debug.Print "That took " & gSW.EndTimer & " ms."
End Sub
Can someone help with this?
Normal.dotm - clsStopWatch (Instancing = PublicNotCreatable)
Option Explicit
Private mlngStart As Long
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Public Sub StartTimer()
mlngStart = GetTickCount
End Sub
Public Function EndTimer() As Long
EndTimer = (GetTickCount - mlngStart)
End Function
Normal.dotm - Module1
Public Function StopWatch() As clsStopWatch
Set StopWatch = New clsStopWatch
End Function
Document1 - Module1
Sub Tester()
Dim sw As normal.clsStopWatch, i As Long
Set sw = normal.stopwatch
sw.StartTimer
For i = 1 To 10000000#
'
Next i
Debug.Print sw.endtimer
End Sub
Related
If my mouse is pressed continuously on the Spin Button, the increment keeps happening. However, the Command Button requires me to click again and again. How can I have the Command Button behave in a similar fashion to that of a Spin Button?
Private Sub CommandButton2_Click()
Label1.Caption = Int(Label1.Caption) + 10
End Sub
Private Sub spbSpinButton_Change()
spbSpinButton.Min = 100
spbSpinButton.Max = 200
spbSpinButton.SmallChange = 10
Label1.Caption = spbSpinButton.Value
End Sub
You can't do it with the Click event, but if you keep track of MouseUp and MouseDown you can trigger a loop. Something like this:
Add a module
Put this code in the module. Give the module any name, but it is referred to as Module1 below.
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
In your Form
Put this in your Module
Dim ButtonDown As Boolean
Private Sub UserForm_Activate()
ButtonDown = False
End Sub
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ButtonDown = True
IncrementCounter
End Sub
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ButtonDown = False
End Sub
Sub IncrementCounter()
If ButtonDown Then
Label1.Caption = Int(Label1.Caption) + 10
DoEvents
Module1.Sleep 100
IncrementCounter
End If
End Sub
The Module1.Sleep 100 says wait 100 milliseconds. Adjust to your need.
I am trying to make a countdown in VBA, that displays the seconds in a textbox1. I am using this code below, but nothing happens and the textbox doesn't increment each second. I have tried doing Endtick / 1000 too because it's ms, but to still now avail. Is this the right method I should be using?
Other stuff is happening in the app as the timer is running, so I can't use the WAIT function.
Private Sub CommandButton2_Click()
timer (10)
End Sub
Sub timer(Finish As Long)
Dim NowTick As Long
Dim EndTick As Long
EndTick = GetTickCount + (Finish * 1000)
Do
NowTick = GetTickCount
DoEvents
UserForm1.TextBox1.Text = GetTickCount
Loop Until NowTick >= EndTick
msgbox("Time is up")
End Sub
Add this to a module, separate from the userform code:
Option Explicit
#If Win64 Then
Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
Public Declare Function GetTickCount Lib "kernel32" () As Long
#End If
Sub timer(Finish As Long)
Dim EndTick As Long
EndTick = GetTickCount + (Finish * 1000)
Do
DoEvents
UserForm1.TextBox1.Text = (EndTick - GetTickCount) / 1000
Loop Until GetTickCount >= EndTick
UserForm1.TextBox1.Text = 0
MsgBox ("Time is up")
End Sub
I created a userform in an *.xlam add-in and created a new commandbar and button in the IDE, but when I click the button, the user form is opened in Excel, and focus is forced away from the IDE. Is there a way to open the user form in the IDE instead of the host application without resorting to a .Net COM Add-in?
Here is the code that creates the commandbar and button and handles the button click event.
Option Explicit
Public WithEvents cmdBarEvents As VBIDE.CommandBarEvents
Private Sub Class_Initialize()
CreateCommandBar
End Sub
Private Sub Class_Terminate()
Application.VBE.CommandBars("VBIDE").Delete
End Sub
Private Sub CreateCommandBar()
Dim bar As CommandBar
Set bar = Application.VBE.CommandBars.Add("VBIDE", MsoBarPosition.msoBarFloating, False, True)
bar.Visible = True
Dim btn As CommandBarButton
Set btn = bar.Controls.Add(msoControlButton, , , , True)
btn.Caption = "Show Form"
btn.OnAction = "ShowForm"
btn.FaceId = 59
Set cmdBarEvents = Application.VBE.Events.CommandBarEvents(btn)
End Sub
Private Sub cmdBarEvents_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
CallByName Me, CommandBarControl.OnAction, VbMethod
End Sub
Public Sub ShowForm()
Dim frm As New UserForm1
frm.Show
End Sub
P.S. You may need this line of code to remove the commandbar...
Application.VBE.CommandBars("VBIDE").Delete
Here is an alternative.
Put a button on your user form. For demonstration purpose, I am using this
Next put this code in the userform
Private Sub CommandButton1_Click()
Unload Me
Application.Visible = True
End Sub
Next paste this on top of your class module
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim Ret As Long, ChildRet As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Finally change your Sub ShowForm() to this
Public Sub ShowForm()
Dim frm As New UserForm1
Dim Ret As Long
frm.Show vbModeless
Application.Visible = False
Ret = FindWindow("ThunderDFrame", frm.Caption)
SetWindowPos Ret, HWND_TOPMOST, 100, 100, 250, 200, _
SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub
This is what you get
EDIT
More thoughts. To prevent the user from creating more userforms when the user clicks on smiley, change the Sub ShowForm() to the below. (Alternative would be to disable the smiley and re enable it when the form unload?)
Public Sub ShowForm()
Dim frm As New UserForm1
Dim Ret As Long
Dim formCaption As String
'~~> Set Userform Caption
formCaption = "Blah Blah"
On Error Resume Next
Ret = FindWindow("ThunderDFrame", formCaption)
On Error GoTo 0
'~~> If already there in an instance then exit sub
If Ret <> 0 Then Exit Sub
frm.Show vbModeless
frm.Caption = formCaption
Application.Visible = False
Ret = FindWindow("ThunderDFrame", frm.Caption)
SetWindowPos Ret, HWND_TOPMOST, 100, 100, 250, 200, _
SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub
i tried a lot to make this code to work,but with no chance.
i want to run a link example: www.yahoo.com in chrome but in hidden mode using sw_hide for a moment of time and this is my code :
Imports System.IO
Imports Microsoft.Win32
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Threading
Module Module1
Const SW_HIDE As Integer = 0
Const SW_RESTORE As Integer = 9
Const SW_MINIMIZE As Integer = 6
Const SW_SHOWMINIMIZED As Integer = 2
Dim hWnd As Integer = 0
<DllImport("User32")> Private Function ShowWindow(ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
End Function
Sub main()
Threading.Thread.Sleep(3000)
Dim ProcessProperties As New ProcessStartInfo
ProcessProperties.FileName = "chrome"
ProcessProperties.Arguments = "www.yahoo.com"
Dim myProcess As Process = Process.Start(ProcessProperties)
Threading.Thread.Sleep(5000)
Call Chm()
Threading.Thread.Sleep(10000)
Call shwo()
Threading.Thread.Sleep(1000)
End Sub
Sub Chm()
Dim p As Process() = Process.GetProcessesByName("chrome")
hWnd = p(0).MainWindowHandle.ToInt32
Threading.Thread.Sleep(2000)
ShowWindow(hWnd, SW_HIDE)
End Sub
Sub shwo()
If Not hWnd.Equals(IntPtr.Zero) Then
' is app window found?
ShowWindow(hWnd, SW_SHOWMINIMIZED)
End If
End Sub
End Module
I am trying to get the status of my application when is maximized or minimized. I rewrote the script so that its specific for Excel application. However, I am getting an error on this line:
Private Sub GetWindowStats(Process.GetProcessesByName("Excel")(0).MainWindowHandle)
It says that it needs a comma or ")" is expected. I can't see why it would need one and even if I put one, still get a compile error. Here is my entire code:
'Handle the minimize and maximize events on Excel.
Private Const SW_SHOWMAXIMIZED As Integer = 3
Private Const SW_SHOWMINIMIZED As Integer = 2
Private Const SW_SHOWNORMAL As Integer = 1
Private Structure POINTAPI
Public x As Integer
Public y As Integer
End Structure
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
Private Structure WINDOWPLACEMENT
Public Length As Integer
Public flags As Integer
Public showCmd As Integer
Public ptMinPosition As POINTAPI
Public ptMaxPosition As POINTAPI
Public rcNormalPosition As RECT
End Structure
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As IntPtr, ByRef lpwndpl As WINDOWPLACEMENT) As Integer
Private Declare Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As IntPtr
Private Sub GetWindowStats(Process.GetProcessesByName("Excel")(0).MainWindowHandle)
Dim wp As WINDOWPLACEMENT
wp.Length = System.Runtime.InteropServices.Marshal.SizeOf(wp)
GetWindowPlacement(Handle, wp)
If wp.showCmd = SW_SHOWMAXIMIZED Then ' is window maximized?
If Handle = GetForegroundWindow Then ' is the window foreground?
MessageBox.Show("Maximized and forground")
Else
MessageBox.Show("Maximized")
End If
ElseIf wp.showCmd = SW_SHOWNORMAL Then
If Handle = GetForegroundWindow Then
MessageBox.Show("Normal size and forground")
Else
MessageBox.Show("Normal")
End If
ElseIf wp.showCmd = SW_SHOWMINIMIZED Then
MessageBox.Show("Window is Minimized")
End If
End Sub
That is because it need the type for the parameter for this sub routine not the value.
Private Sub GetWindowStats(Handle As IntPtr)
Dim wp As WINDOWPLACEMENT
wp.Length = System.Runtime.InteropServices.Marshal.SizeOf(wp)
GetWindowPlacement(Handle, wp)
If wp.showCmd = SW_SHOWMAXIMIZED Then ' is window maximized?
If Handle = GetForegroundWindow Then ' is the window foreground?
MessageBox.Show("Maximized and forground")
Else
MessageBox.Show("Maximized")
End If
ElseIf wp.showCmd = SW_SHOWNORMAL Then
If Handle = GetForegroundWindow Then
MessageBox.Show("Normal size and forground")
Else
MessageBox.Show("Normal")
End If
ElseIf wp.showCmd = SW_SHOWMINIMIZED Then
MessageBox.Show("Window is Minimized")
End If
End Sub
To Call it:
GetWindowStats(Process.GetProcessesByName("Excel")(0).MainWindowHandle)
Remember if there are no Excel processes this will throw an error.