Results 1 to 9 of 9
  1. #1
    Lounger
    Join Date
    Feb 2003
    Location
    Bournemouth, Dorset, England
    Posts
    28
    Thanks
    0
    Thanked 0 Times in 0 Posts

    'Don't Touch' Box... (xl97)

    I need to run a long macro, and would like a msgbox to be displayed throughout explaining to the user that the macro is running and that they should be patient and not touch anything.
    Can this be done, and if so, how?

    Thanks.

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: 'Don't Touch' Box... (xl97)

    You can't use a MsgBox for this, for a message box is modal, i.e. code execution is halted until the user has closed it.

    1. A very simple way to inform the user is the status bar:

    Application.StatusBar = "This will take a while. Hands off, please."

    But it might escape the user's attention.

    2. You can create a UserForm and run the code from there. Put a label on the UserForm that tells the user to be patient.

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: 'Don't Touch' Box... (xl97)

    Here is a trick from John Walkenbach that puts a progress indicator on the sheet using a userform. He mentions it and I will emphasize, it does add overhead and could slow macro execution.

    An additional note on Hans' suggestin of the status bar: If you use this and the macro is long, you might want to change it periodically during code execution (if possible). I have creating a message (like sMsg = "Be Patient. Working") then if I have a large loop I will put the code:

    sMsg = sMsg + " ."
    Application.StatusBar = sMsg

    into the loop. This will change the statusbar at intervals in the code, indicating to the user that something is going on and it is working. If you can estimate the percentage completion, you could just use that (eg if you have
    For x = 1 to EndNum
    you could use
    Application.StatusBar = "Be patient. "& format (x/EndNum, "0.0%") & " Complete"

    on every loop.

    Steve

  4. #4
    5 Star Lounger
    Join Date
    Dec 2000
    Location
    Reading/Swindon, Berkshire, United Kingdom
    Posts
    664
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 'Don't Touch' Box... (xl97)

    Another idea I sometimes use is to call your code from command buttons and then modify the command button whilst it is running - then change it back, using application.screenupdating = false to hide anything but your control sheet. I also display progress updates so that people know what the state of play is (myself included!) this includes a basic timer so that people who use the routines on a regular basis know roughly how long they've got to wait.

    the code below is a sample of changing the command buttons- note that i have found (excel 2000) that the order of the properties is important to avoid display artefacts - but that is just a matter of trial and error, I'm afraid.


    Private Sub cmb_4WS_splitlist_Click()

    With cmb_4WS_splitlist
    .Visible = False
    .Caption = "4WS - split list - NOW RUNNING"
    .BackColor = &HFF&
    .ForeColor = &H0&
    .Width = 385
    .Visible = True
    End With

    Call ForecastToClear("4WS_splitlist")

    With cmb_4WS_splitlist
    .Caption = "4WS - split list"
    .Width = 240
    .ForeColor = &HFF00FF
    .BackColor = &HFF00&
    End With

    End Sub



    to display the status messages i use the following:

    Sub ProgressUpdate(strProgMess As String, dblStartTime As Double)
    ThisWorkbook.Activate
    Application.ScreenUpdating = True

    Cells(dblProgRow, 10).Value = strProgMess
    Cells(dblProgRow, 11).Value = Int(Timer - dblStartTime) & " seconds"

    dblProgRow = dblProgRow + 1
    Application.ScreenUpdating = False
    End Sub

    and the following trimmed routine shows how i call the above:



    Option Explicit
    Public dblProgRow As Double

    Sub ForecastToClear(strRegSplit As String)

    Dim dblStartTime As Double

    dblStartTime = Timer
    dblProgRow = 1

    'clear progress updates from previous run
    Range("i:m").ClearContents

    Call ProgressUpdate("Running Initial Error Checks", dblStartTime)

    end sub




    the attached image should give an impression of how this looks in practise:

  5. #5
    Platinum Lounger
    Join Date
    Nov 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    5,016
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 'Don't Touch' Box... (xl97)

    Another "cheat" you could implement easily is to display an animated .gif of a fake progress bar, while the macro is running. I've seen it done, and it can look quite convincing to someone who doesn't know any better <img src=/S/grin.gif border=0 alt=grin width=15 height=15>. Unlike a real progress bar, or emulation thereof, it can't show "real" progress, as measured by % of task completed. They tend to just show "movement", supposedly indicating that things are happening behind the curtains.

    Alan

  6. #6
    3 Star Lounger
    Join Date
    May 2002
    Location
    Toronto, Ontario, Canada
    Posts
    314
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 'Don't Touch' Box... (xl97)

    I like that idea Alan... but where would I get an animated progress bar .gif?

  7. #7
    Platinum Lounger
    Join Date
    Nov 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    5,016
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 'Don't Touch' Box... (xl97)

    <hr>... but where would I get an animated progress bar .gif?<hr>
    That now appears to be the <img src=/S/money.gif border=0 alt=money width=17 height=15> $64,000 question! I'm sure I've seen these fakes on websites, but when I try to search my favourite haunts I come up empty. The one that comes to mind looks pretty much like a real one, except that the business end of the progress indicator (the right hand end of the moving bit) sweeps left -> right, then right -> left in cycles. The only one I found through searching was just a fairly UNconvincing bank of flashing LEDs. But I'll keep looking, because this has me annoyed now.

    The other alternative I'd seen, which I was loathe to mention, was running a looping movie clip. This particular implementation selected a random clip from a collection of "dubious" content... trouble was, apparently, that employees (all male) would keep running the macro unnecessarily, just to see the naughty movies. I'm sure the collection content could be varied appropriately though. <img src=/S/grin.gif border=0 alt=grin width=15 height=15>

    Alan

    Edited - Found something (attached) that might fool some of the people some of the time.

  8. #8
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: 'Don't Touch' Box... (xl97)

    There were several on this site that had some potential.

    I just used edit -find on the page to look for "bar". They weren't "progress indicators" but they did show a bar with movement, so at least the "activity" would be there even though the progress (as a percent) is not even hinted at.

    There are many animated gif sites. Just google on (with quotes): "animated gif"

    Steve

  9. #9
    Platinum Lounger
    Join Date
    Feb 2001
    Location
    Weert, Limburg, Netherlands
    Posts
    4,812
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 'Don't Touch' Box... (xl97)

    Something I have used is this (uses API to show a window):

    '************************************************* **************************
    '* *
    '* MODULE NAME: A NON-MODAL MESSAGE WINDOW *
    '* AUTHOR & DATE: STEPHEN BULLEN, Stephen@bmsltd.ie *
    '* *
    '* DESCRIPTION: Uses Windows API calls to create a Non-modal window *
    '* floating over the Excel worksheet. *
    '* Enjoy and use. *
    '* *
    '@************************************************ **************************

    Option Base 1
    Option Explicit

    '***
    '*** Define some types for the API calls
    '***

    'RECT32
    Type RECT32
    cl As Long
    ct As Long
    cr As Long
    cb As Long
    End Type

    '***
    '*** Declare some Windows API calls
    '***
    Declare Function GetModuleHandle32 Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As Any) As Long
    Declare Function CreateWindowEx32 Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Any, ByVal hInstance As Long, lpParam As Any) As Long
    Declare Function ShowWindow32 Lib "user32" Alias "ShowWindow" (ByVal hwnd As L>'* MODULE NAME: A NON-MODAL MESSAGE WINDOW *
    '* AUTHOR & DATE: STEPHEN BULLEN, Stephen@bmsltd.ie *
    '* *
    '* DESCRIPTION: Uses Windows API calls to create a Non-modal window *
    '* floating over the Excel worksheet. *
    '* Enjoy and use. *
    '* *
    '@************************************************ **************************

    Option Base 1
    Option Explicit

    '***
    '*** Define some types for the API calls
    '***

    'RECT32
    Type RECT32
    cl As Long
    ct As Long
    cr As Long
    cb As Long
    End Type

    '***
    '*** Declare some Windows API calls
    '***
    Declare Function GetModuleHandle32 Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As Any) As Long
    Declare Function CreateWindowEx32 Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Any, ByVal hInstance As Long, lpParam As Any) As Long
    Declare Function ShowWindow32 Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Declare Sub SetWindowText32 Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String)
    Declare Function DestroyWindow32 Lib "user32" Alias "DestroyWindow" (ByVal hwnd As Long) As Long
    Declare Function GetForegroundWindow Lib "user32.dll" () As Long
    Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long



    '***
    '*** Declare some constants for use with the API calls
    '***
    Const GWL_HINSTANCE = (-6)
    Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
    Const WS_BORDER = &H800000
    Const WS_CHILD = &H40000000
    Const SW_SHOWNOACTIVATE = 4
    Const SW_HIDE = 0
    Const SS_CENTER = &H1&


    'Dimension some variables.
    Dim hWnd32 As Long
    Dim hWndTxt32 As Long

    '***
    '*** Create and show the window
    '***
    Public Sub ShowMsgWindow(sWindowcaption As String)
    Dim hWndP As Long
    Dim hWndP1 As Long
    Dim hWndP2 As Long
    Dim hInstP As Long
    Dim a As Long
    Dim iHeight As Integer
    Dim iWidth As Integer
    Dim iXpos As Integer
    Dim iYpos As Integer
    'Find the hWnd of the main Excel window
    hWndP1 = GetForegroundWindow
    hWndP2 = Application.VBE.MainWindow.hwnd
    If hWndP1 = hWndP2 Then
    hWndP = Application.VBE.MainWindow.hwnd
    Else
    hWndP =ong, ByVal nCmdShow As Long) As Long
    Declare Sub SetWindowText32 Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String)
    Declare Function DestroyWindow32 Lib "user32" Alias "DestroyWindow" (ByVal hwnd As Long) As Long
    Declare Function GetForegroundWindow Lib "user32.dll" () As Long
    Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long



    '***
    '*** Declare some constants for use with the API calls
    '***
    Const GWL_HINSTANCE = (-6)
    Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
    Const WS_BORDER = &H800000
    Const WS_CHILD = &H40000000
    Const SW_SHOWNOACTIVATE = 4
    Const SW_HIDE = 0
    Const SS_CENTER = &H1&


    'Dimension some variables.
    Dim hWnd32 As Long
    Dim hWndTxt32 As Long

    '***
    '*** Create and show the window
    '***
    Public Sub ShowMsgWindow(sWindowcaption As String)
    Dim hWndP As Long
    Dim hWndP1 As Long
    Dim hWndP2 As Long
    Dim hInstP As Long
    Dim a As Long
    Dim iHeight As Integer
    Dim iWidth As Integer
    Dim iXpos As Integer
    Dim iYpos As Integer
    'Find the hWnd of the main Excel window
    hWndP1 = GetForegroundWindow
    hWndP2 = Application.VBE.MainWindow.hwnd
    If hWndP1 = hWndP2 Then
    hWndP = Application.VBE.MainWindow.hwnd
    Else
    hWndP = FindWindow32("XLMAIN", Application.Caption)
    End If
    'Find the module handle of Excel
    hInstP = GetModuleHandle32(0&)
    iXpos = 400
    iYpos = 300
    iWidth = 200
    iHeight = 100
    'Create my own dialog box window - #32770 is a standard dialog box
    hWnd32 = CreateWindowEx32(0, "#32770", sWindowcaption, WS_BORDER + WS_CAPTION, iXpos, iYpos, iWidth, iHeight, hWndP, 0&, hInstP, 0&)
    hWndTxt32 = CreateWindowEx32(0, "Static", Chr(10) & "", WS_CHILD + SS_CENTER, 0, 0, 200, 100, hWnd32, 0&, hInstP, 0&)

    'Show my dialog window, without activating it
    a = ShowWindow32(hWndTxt32, SW_SHOWNOACTIVATE)
    a = ShowWindow32(hWnd32, SW_SHOWNOACTIVATE)
    End Sub
    '***
    '*** Change the window message
    '***
    Public Sub MsgWindowMessage(sMsg As String)

    'Draw the text on the edit box
    SetWindowText32 hWndTxt32, Chr(10) & sMsg
    End Sub


    '***
    '*** Tidy up and remove the window
    '***
    Public Sub KillMsgWindow()

    Dim a As Long

    'Tidy up, hide and delete the window
    a = ShowWindow32(hWnd32, SW_HIDE)
    a = DestroyWindow32(hWnd32)
    End Sub
    Sub testme()
    ShowMsgWindow "Window Caption"
    MsgWindowMessage "Don't go away!!!"
    End Sub

    Run the last sub to test, run KillmsgWindow to get rid of the window.
    Jan Karel Pieterse
    Microsoft Excel MVP, WMVP
    www.jkp-ads.com
    Professional Office Developers Association

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •