Форма пользователя VBA Center на активном экране

Question

Интересно, может ли кто-нибудь помочь мне, пожалуйста.

Я использую приведенный ниже код "Извлечь", который запускается по нажатию кнопки, которая также, как вы можете видеть, запускает форму "Всплеск" с полосой прокрутки.

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

Поскольку я использую двойные мониторы, я исследовал, как расположить заставку на "Активном окне", и одна из многочисленных публикаций привела меня к использованию кода ниже:

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

Проблема, с которой я столкнулся, заключается в том, что хотя экран "Всплеск" виден и теперь находится в центре активного окна, макрос извлечения больше не работает, и я действительно не уверен, почему.

Мне просто интересно, может ли кто-нибудь посмотреть на это, пожалуйста, и дайте мне знать, где я ошибся.

Большое спасибо и всего наилучшего

Крис

Answer 1

Я просто хотел опубликовать свое рабочее решение, которое, основываясь на том, что я уже написал, коллега по работе смог закончить.

Код выглядит следующим образом:

Private Sub UserForm_Initialize()

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

а также

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

Большое спасибо и всего наилучшего

Крис

Answer 2

Проблема в том, что вы показываете форму как модальную, которая останавливает фоновое выполнение кода.

В свойствах форм установите ShowModal в false.