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


Comments

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Powerpoint countdown and current time in slides VBA

Revit 2019 and up tab colorizer