Outlook VBA for "message domain" Progress form
One other tidbit- the progress form - a cheap way to create a progress bar on x64 outlook VBA since the regular x32 bit active x controllers don't work... I used a form- named it 1)"frmProgress", on the form is a frame called 3) "ProgressFrame", which I changed the fill on,hovering above (or in ) the frame is a lebel text called 2) "labelProgress" and there is an OK button called 4) "OK" for closing down the dialog.
Dialog in the form is below:
The code to run the dialog is very simple...
Code below this line--------------------------------------
Public MAX As Integer
Public Current As Integer
Private Sub OK_Click()
Me.Hide
End Sub
Private Sub UserForm_Initialize()
ProgressFrame.Caption = ""
Me.Left = Application.ActiveWindow().Left + Application.ActiveWindow().Width / 2 - (Me.Width / 2)
Me.Top = Application.ActiveWindow().Top + Application.ActiveWindow().Height / 2 - (Me.Height / 2)
Me.Height = 33
End Sub
Public Function SetCurrent(value As Integer)
Dim Width As Integer
If Me.Visible = False Then Me.Show (0)
If MAX = 0 Then MAX = 1
'If Value = 0 Then Value = 1
If value > MAX Then value = MAX ''100% max
Width = (Me.Width - 15) * value / MAX
If Width < 1 Then Width = 1
ProgressFrame.Width = Width
Me.labelProgress.Caption = Format(value / MAX * 100, "000") & "%"
Me.Repaint
DoEvents
If value = MAX Then
Me.labelProgress.Caption = Me.labelProgress.Caption & " **DONE**"
Me.Height = 64
End If
End Function
Public Function SetMax(value As Integer)
Dim Width As Integer
MAX = value
SetCurrent (0)
End Function
Dialog in the form is below:
The code to run the dialog is very simple...
Code below this line--------------------------------------
Public MAX As Integer
Public Current As Integer
Private Sub OK_Click()
Me.Hide
End Sub
Private Sub UserForm_Initialize()
ProgressFrame.Caption = ""
Me.Left = Application.ActiveWindow().Left + Application.ActiveWindow().Width / 2 - (Me.Width / 2)
Me.Top = Application.ActiveWindow().Top + Application.ActiveWindow().Height / 2 - (Me.Height / 2)
Me.Height = 33
End Sub
Public Function SetCurrent(value As Integer)
Dim Width As Integer
If Me.Visible = False Then Me.Show (0)
If MAX = 0 Then MAX = 1
'If Value = 0 Then Value = 1
If value > MAX Then value = MAX ''100% max
Width = (Me.Width - 15) * value / MAX
If Width < 1 Then Width = 1
ProgressFrame.Width = Width
Me.labelProgress.Caption = Format(value / MAX * 100, "000") & "%"
Me.Repaint
DoEvents
If value = MAX Then
Me.labelProgress.Caption = Me.labelProgress.Caption & " **DONE**"
Me.Height = 64
End If
End Function
Public Function SetMax(value As Integer)
Dim Width As Integer
MAX = value
SetCurrent (0)
End Function
Comments
Post a Comment