Excel Pop Up "Processing..." message

Posted on 2007-04-03
Last Modified: 2012-08-14
I've got some Excel VBA code running in a file and would like to notify the user that the code is "processing" via a pop up.  In know how to do this by changing the status bar, but is it possible to have a pop up window appear when code is running, then automatically disappear when done?  Thanks!
Question by:erichranz
  • 2
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 18846214
Here is some code that will present a progress bar with status messages.

' This library is intended to be placed in a Form. To add a progress form to a project, created a new default
' form and add this module to the form. Do not set any form properties or add any controls - the module code
' sets the form properties and creates all needed controls.
' The progress form is controlled with the following methods and functions:
'   Initialize - Initializes and shows the form. Must be called before any other method.
'   BeginProgress - Starts the progress bar.
'   BumpProgress - Increments the progress bar one unit.
'   EndProgress - Clears the form status settings.
'   Terminate - Closes the form.
' Example:
'   frmProgress.Initialize
'   frmProgress.BeginProgress "Doing something", 20 ' the second parameter is the number of steps
'   For Index = 1 to 20
'      ' Do some work
'      frmProgress.BumpProgress
'   Next Index
'   frmProgress.EndProgress
'   frmProgress.Terminate
' © 2007 Kevin M. Jones

Option Explicit

Private Const mFontName = "Tahoma"
Private Const mFontSize = 8
Private Const mBorderWidth = 9 ' Twips (usually 12 pixels)
Private Const mGridSize = 6 ' Twips (usually 8 pixels)
Private Const mFormHFudge = 4.5 ' Twips
Private Const m2000FormVFudge = 18 ' Twips
Private Const m2002FormVFudge = 24 ' Twips

Private WithEvents mcmdCancel As clsCommandButton
Private mlblStatus As msforms.Label
Private mfraProgressBack As msforms.Frame
Private mfraProgressFront As msforms.Frame
Private mlblProgressBack As msforms.Label
Private mlblProgressFront As msforms.Label

Private mInitialized As Boolean
Private mCancelled As Boolean
Private mSegmentCount As Long
Private mSegmentIndex As Long
Private mPercentComplete As Single
Private mStatusText As String
Private mLastPercentComplete As Single
Private mMaxFrontProgressFrameWidth As Single

Private Const mLogicalPixelsPerInchX = 88 ' logical pixels per inch horizontal
Private Const mLogicalPixelsPerInchY = 90 ' logical pixels per inch vertical
Private Const mPointsPerLogicalInch = 72& ' points per logical inch

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
   ByVal hdc As Long, _
   ByVal nIndex As Long) As Long

Private Declare Function GetDC Lib "user32" ( _
   ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" ( _
   ByVal hwnd As Long, _
   ByVal hdc As Long) As Long

Public Function BeginProgress( _
      Optional ByVal StatusText As String, _
      Optional ByVal SegmentCount As Long = 100 _
   ) As Boolean

' Starts progress bar.
   mSegmentCount = SegmentCount
   mSegmentIndex = 0
   mStatusText = StatusText

   BeginProgress = mCancelled

End Function

Public Function BumpProgress( _
      Optional ByVal StatusText As Variant _
   ) As Boolean
' Bump the progress bar one segment. Returns true if cancel requested.
   Dim Index As Long
   mSegmentIndex = mSegmentIndex + 1
   If Not IsMissing(StatusText) Then
      mStatusText = StatusText
   End If
   BumpProgress = mCancelled

End Function

Public Property Get Cancelled() As Boolean

' Return the Cancelled status.

   Cancelled = mCancelled

End Property

Private Sub cmdCancel_Click()

' Record the request to cancel.

   mCancelled = True

End Sub

Public Sub EndProgress()

' Set reset the initialized flag.

   mInitialized = False

End Sub

Public Sub Initialize( _
      Optional ByVal WindowTitle As String = "Please Wait...", _
      Optional ByVal StatusText As String = "Initializing", _
      Optional ByVal SegmentCount As Long = 100, _
      Optional ByVal AllowCancel As Boolean = False _
' Initialize the progress form.

   Dim Control As msforms.Control
   If SegmentCount < 1 Then SegmentCount = 1

   Set Control = Nothing
   On Error Resume Next
   Set Control = Me.Controls("lblStatus")
   On Error GoTo 0
   If Control Is Nothing Then
      ' Set form properties
      Me.Width = 500
      Me.Height = 0
      Me.Font.Name = mFontName
      Me.Font.Size = mFontSize
      Me.Caption = WindowTitle
      ' Add status label
      Set mlblStatus = Me.Controls.Add("Forms.Label.1", "lblStatus", True)
      mlblStatus.Width = Me.Width - 2 * mBorderWidth - mFormHFudge
      mlblStatus.Height = 11.25 ' Twips
      mlblStatus.Left = mBorderWidth
      mlblStatus.Top = mBorderWidth
      ' Add back progress frame
      Set mfraProgressBack = Me.Controls.Add("Forms.Frame.1", "fraProgressBack", True)
      mfraProgressBack.Width = Me.Width - 2 * mBorderWidth - mFormHFudge
      mfraProgressBack.Height = PointsFromPixelsY(20)
      mfraProgressBack.Left = mBorderWidth
      mfraProgressBack.Top = mlblStatus.Top + mlblStatus.Height + mGridSize
      mfraProgressBack.Caption = ""
      mfraProgressBack.BorderStyle = fmBorderStyleSingle
      mfraProgressBack.SpecialEffect = fmSpecialEffectSunken
      mfraProgressBack.BackColor = &HFFFFFF
      ' Add back progress label
      Set mlblProgressBack = Me.Controls("fraProgressBack").Controls.Add("Forms.Label.1", "lblProgressBack", True)
      mlblProgressBack.Width = mfraProgressBack.Width
      mlblProgressBack.Height = mfraProgressBack.Height
      mlblProgressBack.Left = 0
      mlblProgressBack.Top = PointsFromPixelsY(1)
      mlblProgressBack.ForeColor = &HC00000
      mlblProgressBack.Font.Bold = True
      mlblProgressBack.TextAlign = fmTextAlignCenter
      ' Add front progress frame
      Set mfraProgressFront = Me.Controls.Add("Forms.Frame.1", "fraProgressFront", True)
      mfraProgressFront.Width = mfraProgressBack.Width - PointsFromPixelsX(4)
      mfraProgressFront.Height = mfraProgressBack.Height - PointsFromPixelsY(4)
      mfraProgressFront.Left = mfraProgressBack.Left + PointsFromPixelsX(2)
      mfraProgressFront.Top = mfraProgressBack.Top + PointsFromPixelsY(2)
      mfraProgressFront.Caption = ""
      mfraProgressFront.BorderStyle = fmBorderStyleNone
      mfraProgressFront.SpecialEffect = fmSpecialEffectFlat
      mfraProgressFront.BackColor = &HC00000
      mMaxFrontProgressFrameWidth = mfraProgressFront.Width
      ' Add front progress label
      Set mlblProgressFront = Me.Controls("fraProgressFront").Controls.Add("Forms.Label.1", "lblProgressFront", True)
      mlblProgressFront.Width = mfraProgressFront.Width
      mlblProgressFront.Height = mlblProgressBack.Height
      mlblProgressFront.Left = PointsFromPixelsX(2)
      mlblProgressFront.Top = PointsFromPixelsY(1)
      mlblProgressFront.ForeColor = &HFFFFFF
      mlblProgressFront.Font.Bold = True
      mlblProgressFront.TextAlign = fmTextAlignCenter
      ' Add cancel command button
      Set mcmdCancel = New clsCommandButton
      Set mcmdCancel.CommandButton = Me.Controls.Add("Forms.CommandButton.1", "cmdCancel", True)
      mcmdCancel.CommandButton.Width = 9 * mGridSize
      mcmdCancel.CommandButton.Height = 3 * mGridSize
      mcmdCancel.CommandButton.Left = Me.Width - mBorderWidth - mcmdCancel.CommandButton.Width - mFormHFudge
      mcmdCancel.CommandButton.Top = mfraProgressBack.Top + mfraProgressBack.Height + mGridSize
      mcmdCancel.CommandButton.Caption = "Cancel"
   End If
   ' Size form based on whether or not cancel allowed
   If AllowCancel Then
      mcmdCancel.CommandButton.Visible = True
      Me.Height = mcmdCancel.CommandButton.Top + mcmdCancel.CommandButton.Height + mBorderWidth + IIf(Application.Version < 10, m2000FormVFudge, m2002FormVFudge)
      mcmdCancel.CommandButton.Visible = False
      Me.Height = mfraProgressBack.Top + mfraProgressBack.Height + mBorderWidth + IIf(Application.Version < 10, m2000FormVFudge, m2002FormVFudge)
   End If
   ' Clear levels
   mSegmentIndex = 0
   mSegmentCount = SegmentCount
   mStatusText = 0
   ' Set progress bar to 0 percent complete
   mfraProgressFront.Width = 0
   ' Show progress form
   Me.Show vbModeless
   ' Initialize status
   mLastPercentComplete = -1
   mInitialized = True
   mCancelled = False
   ' Start progress
   BeginProgress StatusText, SegmentCount

End Sub

Private Sub mcmdCancel_Click()

' Set cancelled status.

   mCancelled = True

End Sub

Public Function PointsFromPixelsX(ByVal Pixels As Long) As Single
' Returns as points the provided horizontal position in pixels.
   Dim DC As Long

   DC = GetDC(0)
   PointsFromPixelsX = Abs((Pixels * mPointsPerLogicalInch) / GetDeviceCaps(DC, mLogicalPixelsPerInchX))
   ReleaseDC 0, DC
End Function

Public Function PointsFromPixelsY(ByVal Pixels As Long) As Single

' Returns as points the provided vertical position in pixels.
   Dim DC As Long

   DC = GetDC(0)
   PointsFromPixelsY = Abs((Pixels * mPointsPerLogicalInch) / GetDeviceCaps(DC, mLogicalPixelsPerInchY))
   ReleaseDC 0, DC
End Function

Public Function SetStatus( _
      Optional ByVal StatusText As String _
   ) As Boolean
' Sets the status text. Returns true if cancel requested.

   mStatusText = StatusText
   SetStatus = mCancelled

End Function

Public Sub Terminate()

' Terminates the form (hides it.)
   mInitialized = False


End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

' Handle requests to manually close the window. Treat as a cancel request if cancel allowed, ignore
' otherwise.

   If CloseMode = vbFormControlMenu Then
      Cancel = True
      mCancelled = True
   End If

End Sub

Private Sub UpdateStatus()

' Update the progress form text and progress bar.

   Dim PercentComplete As Single

   ' Give UI cycles to handle Cancel command button click

   If mSegmentCount = 0 Then
      PercentComplete = 100
      PercentComplete = mSegmentIndex / mSegmentCount * 100
   End If
   ' Only update progress bar if percent complete has changed
   If PercentComplete <> mLastPercentComplete Then
      mfraProgressFront.Width = Application.Min(PercentComplete / 100, 1) * mMaxFrontProgressFrameWidth
      mlblProgressFront.Caption = Format(PercentComplete, "0") & "%"
      mlblProgressBack.Caption = Format(PercentComplete, "0") & "%"
      mLastPercentComplete = PercentComplete
   End If
   ' Only update status text if status text has changed
   If mStatusText <> mlblStatus.Caption Then
      mlblStatus.Caption = mStatusText
   End If

End Sub

LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 18846235
You will also need the following class. Add a new class, name it clsCommandButton, and paste this code in it:

Option Explicit

' Class is used to capture command button events when the command button is added at run time.

Public WithEvents CommandButton As msforms.CommandButton

Public Event Click()

Public Sub CommandButton_Click()

   RaiseEvent Click

End Sub

LVL 26

Accepted Solution

EDDYKT earned 125 total points
ID: 18849926

create a new form


' do you job

Unload frmSplash

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

828 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question