Workbook opening sequence

[dmacmillan]

Hi All,

On opening a workbook (a KPI Dashboard) the following needs to occur: change the display, hide the cursor, show a splash form, insert a date stamp, show another form for c.30 seconds and establish an Application.OnTime structure (altogether 'RefreshPrism') and finally show graphs that cycle a combo box every 5 seconds and refresh the graph. This code follows:

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Call SetDisplay
    Call HidePointer
    frmFMLSplash.show
    Worksheets("Parameters").Range("C27") = Format(Now, "d-mmm-yy")
    Call RefreshPrism
    Call CycleGraphs
End Sub

This code results in the user forms overlaying each other and the combo box not being refreshed.

Possibly the date stamp, being a volatile function, is wreaking havoc. I am bamboozled and would be grateful for recommendations to effectively sequence this On Open procedure.

Kind regards,
David

 

[dmacmillan]

Any thoughts would be welcomed. More information required? My research yielded nothing of use and I'm tearing my hair out ...

 

[Sektor]

frmFMLSplash.show [B][COLOR="Red"]vbModeless[/COLOR][/B]

 

[dmacmillan]

Hi Sektor,

Thanks for contributing but unfortunately that didn't resolve the issue. Unfortunately the file is too large (2.2mb) but I have attached the VBA code for review below. Essentially the sequencing is askew. Per my first post, I want the following to occur one after the other:

1. Open the Workbook to "ROTAMAG" (where graphs are located) and change the display (ultimately hiding the cursor);
2. Insert a date stamp (for purposes of calculations imbeded in another sheet);
3. Show a splash;
4. Show another form for c.30 seconds and establish an Application.OnTime structure (altogether the 'RefreshPrism' macro); and
5. Cycle the graphs on "ROTAMAG" via a combo box every 5 seconds and refresh the graph.

The code follows:

This Workbook

Private Declare Function ShowCursor Lib "user32" _ 
(ByVal fShow As Integer) As Integer 
 
 
Private Sub Workbook_Activate() 
    Application.ScreenUpdating = False 
    Call SetDisplay 
    Application.ScreenUpdating = True 
End Sub 
 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
     'Call StopTimer
     'Call ShowPointer
    ActiveWorkbook.Save 
End Sub 
 
 
Private Sub Workbook_Deactivate() 
    Call ResetDisplay 
End Sub 
 
 
Private Sub Workbook_Open() 
    Application.ScreenUpdating = False 
    Call SetDisplay 
     'Call HidePointer
    frmFMLSplash.show 
    Worksheets("Parameters").Range("C27") = Format(Now, "d-mmm-yy") 'Date Stamp
    Call RefreshPrism 
    Call CycleGraphs 
End Sub

Form - Splash

Private Sub UserForm_Activate() 
    Const SS_DURATION As Long = 5 
    Application.OnTime Now + TimeSerial(0, 0, SS_DURATION), "KillForm" 
End Sub

Form - Processing (Data)

Private Sub UserForm_Activate() 
    Me.Repaint 
    Application.Run Macro_to_Process 
    Unload Me 
End Sub 
 
 
Private Sub UserForm_Initialize() 
    lblMessage.Caption = Processing_Message 
End Sub

Module - Data Import

Public RunWhen As Double 
Public Const cRunIntervalMinutes = 2 
Public Const cRunWhat = "RefreshPrism" 
Public Processing_Message As String 
Public Macro_to_Process As String 
Public intMax As Long 
Public intIndex As Long 
Public sngPercent As Double 
 
 
Sub RefreshPrism() 
     'StartTimer
    StartProcessing "Refreshing Prism Data, Please Wait ... ", "MyMacro" 
End Sub 
 
 
Sub StartTimer() 
    RunWhen = Now + TimeSerial(0, cRunIntervalMinutes, 0) 
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _ 
    Schedule:=True 
End Sub 
 
 
Sub StopTimer() 
    On Error Resume Next 
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _ 
    Schedule:=False 
End Sub 
 
 
Sub StartProcessing(msg As String, code As String) 
    Processing_Message = msg 
    Macro_to_Process = code 
    frmProcessing_Dialog.show 
End Sub 
 
 
Sub MyMacro() 
    intMax = 10000 
    For intIndex = 1 To intMax 
        sngPercent = (intIndex / intMax) 
        With frmProcessing_Dialog 
            .Caption = "Prism Data Importation " & Format(sngPercent, "0%") & " Complete ... " 
        End With 
        DoEvents 
    Next 
    Application.StatusBar = False 
End Sub

Module - Display

Sub ColourGraphs() 
    Dim cht As Chart 
    Dim srs As Series 
    Dim rPatterns As Range 
    Dim iPattern As Long 
    Dim vPatterns As Variant 
    Dim iPoint As Long 
    Dim vValues As Variant 
     
     
    Set cht = Worksheets("ROTAMAG").ChartObjects("Chart 2").Chart 
    Set rPatterns = Worksheets("Parameters").Range("C17:E17") 
    vPatterns = rPatterns.Value 
     
     
    With cht 
        For Each srs In cht.SeriesCollection 
            With srs 
                vValues = .Values 
                For iPoint = 1 To UBound(vValues) 
                    For iPattern = 1 To UBound(vPatterns, 2) 
                        If vValues(iPoint) <= vPatterns(1, iPattern) Then 
                            .Points(iPoint).Interior.ColorIndex = rPatterns.Cells(1, iPattern).Interior.ColorIndex 
                            Exit For 
                        End If 
                    Next 
                Next 
            End With 
        Next 
    End With 
End Sub 
 
 
Sub SetDisplay() 
    With ActiveWindow 
        .Caption = "" 
        .DisplayGridlines = False 
        .DisplayHeadings = False 
        .DisplayHorizontalScrollBar = False 
        .DisplayVerticalScrollBar = False 
        .DisplayWorkbookTabs = False 
        .WindowState = xlMaximized 
    End With 
    With Application 
        .Caption = "ROTAMAG KPI DASHBOARD" 
        .DisplayFullScreen = True 
        .DisplayFormulaBar = False 
        .DisplayStatusBar = False 
    End With 
End Sub 
 
 
Sub ResetDisplay() 
    ActiveWindow.Caption = ActiveWorkbook.Name 
    With Application 
        .Caption = Empty 
        .DisplayFullScreen = False 
        .DisplayFormulaBar = True 
        .DisplayStatusBar = True 
    End With 
End Sub 
 
 
Sub KillForm() 
    Unload frmFMLSplash 
End Sub 
 
 
Sub CycleGraphs() 
    Dim cbxItem As MSForms.ComboBox 
    Dim strList As String 
    Dim rngList As Range 
    Dim i As Integer 
     
    Set cbxItem = Worksheets("ROTAMAG").cboRotamag 
    strList = cbxItem.ListFillRange 
    Set rngList = Range(strList) 
     
    Worksheets("Rotamag").Select 
     
    For i = 0 To rngList.Count - 1 
        cbxItem.ListIndex = i 
        DoEvents 
        cbxItem.Value = cbxItem.Text 
        DoEvents 
        Call ColourGraphs 
        Application.Wait (Now + TimeSerial(0, 0, 5)) 
        Debug.Print Now 
    Next i 
     'Run "CycleGraphs"
End Sub 
 
 
Sub HidePointer() 
    While ShowCursor(False) >= 0 
    Wend 
End Sub 
 
Sub ShowPointer() 
    While ShowCursor(True) < 0 
    Wend 
End Sub

Really welcome any assistance here.

Kind regards,
David