VBA Centre Userform On Active Screen

Question

I wonder whether someone can help me please.

I'm using the 'Extract' code below which runs on the click of a button, which also, as you may be able to see, initalises a 'Splash' form with a scrolling progress bar.

Private Sub btnFetchFiles_Click()

    Dim j As Integer

    'Display the splash form non-modally.
    Set frm = New frmSplash
    frm.TaskDone = False
    frm.prgStatus.Value = 0
'    frm.Show False

    For j = 1 To 1000
        DoEvents
        Next j

        iRow = 20
        fPath = "\\c\s\CAF1\Dragon Mentor Group\Dragon Scripts\Current\April 2015"
        If fPath <> "" Then
            Set FSO = New Scripting.FileSystemObject
            frm.prgStatus.Value = 10
            If FSO.FolderExists(fPath) <> False Then
                frm.prgStatus.Value = 20
                Set SourceFolder = FSO.GetFolder(fPath)
                IsSubFolder = True
                frm.prgStatus.Value = 30
                Call DeleteRows
                frm.prgStatus.Value = 40
                If AllFilesCheckBox.Value = True Then
                    frm.prgStatus.Value = 50
                    Call ListFilesInFolder(SourceFolder, IsSubFolder)
                    frm.prgStatus.Value = 60
                    Call ResultSorting(xlAscending, "C20")
                    frm.prgStatus.Value = 70
                Else
                    Call ListFilesInFolderXtn(SourceFolder, IsSubFolder)
                    frm.prgStatus.Value = 80
                    Call ResultSorting(xlAscending, "C20")
                    frm.prgStatus.Value = 90
                End If
                Call FormatCells
                lblFCount.Caption = iRow - 20
                frm.prgStatus.Value = 100
            End If
        End If
 frm.TaskDone = True
        Unload frm
'The row below creates a 'On Screen' message telling the user that the workbook has been built.
        iMessage = MsgBox("All the files have been extracted", vbOKOnly)
'The row below automatically takes the user to the "Launch Sheet".
    End Sub

Because I'm using dual monitors I've been researching how to centre the splash screen ont the 'Active Window'and one of the many posts has led me to use the code below:

Private Sub UserForm_Initialize()

    Me.BackColor = RGB(174, 198, 207)
        With frmSplash
            .StartUpPosition = 0
            .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
            .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
    .Show
End With
End Sub

The problem I now have is that although the 'Splash' screen is visible and now centred to the active window the extract macro no longer works and I'm really not sure why.

I just wondered whether someone could look at this please and let me know where I've gone wrong.

Many thanks and kind regards

Chris

Solution 1

I just wanted to post my working solution, which building upon what I'd alreafdy written, a work colleague was able to finish.

The code is as follows:

Private Sub UserForm_Initialize()

    Me.BackColor = RGB(174, 198, 207)
End Sub

and

Private Sub Workbook_Open()

    Dim j As Integer

    'Display the splash form non-modally.
    Set frm = New frmSplash
    With frm
        .TaskDone = False
        .prgStatus.Value = 0
        .StartUpPosition = 0
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
        .Show False
    End With

    For j = 1 To 1000
        DoEvents
        Next j

        iRow = 17
        fPath = "\\c\s\CAF1\Dragon Mentor Group\Dragon Scripts\Current\April 2015"
        If fPath <> "" Then
            Set FSO = New Scripting.FileSystemObject
            frm.prgStatus.Value = 15
            If FSO.FolderExists(fPath) <> False Then
                frm.prgStatus.Value = 30
                Set SourceFolder = FSO.GetFolder(fPath)
                IsSubFolder = True
                frm.prgStatus.Value = 45
                Call DeleteRows
                frm.prgStatus.Value = 60
                    Call ListFilesInFolder(SourceFolder, IsSubFolder)
                    frm.prgStatus.Value = 75
                Call FormatCells
                frm.prgStatus.Value = 100
            End If
        End If
 frm.TaskDone = True
        Unload frm
'The row below creates a 'On Screen' message telling the user that the workbook has been built.
        iMessage = MsgBox("All the files have been extracted", vbOKOnly)
'The row below automatically takes the user to the "Launch Sheet".
End Sub

Many thanks and kind regards

Chris

Solution 2

The problem you have is you are showing the form as a modal, which stops background code execution.

In the forms properties set ShowModal to false.

Comments

[IRHM]

Hi @Steven, thank you for this, this certainly makes the form centre correctly, thank you. Unfortunately though the progress bar no longer scrolls across the form. Kind Regards. Chris