R – Progress bar using Office VBA


I have a small programme that opens and closes a number of different word documents while it runs. It loads some documents from the web so it takes a little while and I'd prefer to let the user watch a little progress bar or at least have a message in a form telling them to wait.

I can't seem to be able to keep that form on top of all other Office windows, however.

I have no problem with the code for the actual progress bar, just keeping the damn thing on top while the code is opening and closing windows. I tried hiding the application but this seems to prevent some of the code from running.

Regardless of whether I have modal or modeless set the form goes behind the activewindow and when it occasionally shows on top it won't repaint.

I may have just missed a "stayontop" property or something?


Best Solution

I don't think there's any built-in way to make a form stay on top in VBA, but one question is are you calling DoEvents when you're updating anything on your form? My experience has been that the form doesn't repaint unless you call DoEvents, for instance, before hitting the Next statement in a loop.

If that's not your problem, you can use Windows API calls to put a window at the top, though I'm not sure it stays at the top using this code:

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long

Const SWP_NOMOVE = 2
Const SWP_NOSIZE As Long = 1

Private Declare Function SetWindowPos Lib "user32" _
      (ByVal hwnd As Long, _
      ByVal hWndInsertAfter As Long, _
      ByVal x As Long, _
      ByVal y As Long, _
      ByVal cx As Long, _
      ByVal cy As Long, _
      ByVal wFlags As Long) As Long

Private Function SetTopMostWindow(hwnd As Long, Topmost As Boolean) As Long

   If Topmost = True Then 'Make the window topmost
      SetTopMostWindow = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
      SetTopMostWindow = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
      SetTopMostWindow = False
   End If
End Function

Private Function GetFormHwnd() As Long
    GetFormHwnd = FindWindow(CLng(0), Me.Caption)
End Function

Public Sub SetFormAsTopMostWindow()
    Call SetTopMostWindow(GetFormHwnd(), True)
End Sub

I put this in a form's code module and it seems to work when moving other applications around; it stays on top.

Related Question