Solved

Excel Pop Up "Processing..." message

Posted on 2007-04-03
3
1,056 Views
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!
0
Comment
Question by:erichranz
  • 2
3 Comments
 
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
   
   UpdateStatus

   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
   
   UpdateStatus
   
   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)
   Else
      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
   
   UpdateStatus
   
   SetStatus = mCancelled

End Function

Public Sub Terminate()

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

   Me.Hide

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
   DoEvents

   If mSegmentCount = 0 Then
      PercentComplete = 100
   Else
      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

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

Kevin
0
 
LVL 26

Accepted Solution

by:
EDDYKT earned 125 total points
ID: 18849926
?

create a new form

frmSplash.Show
frmSplash.Refresh

' do you job

Unload frmSplash
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
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.

746 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now