在活动屏幕上居中显示VBA用户窗体

Question

我想知道是否有人可以帮助我。

我正在使用以下“提取”代码，该代码在单击按钮时运行，并且还初始化一个带有滚动进度条的“Splash”表单，正如您可能看到的那样。

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

我现在遇到的问题是，虽然“闪屏”界面可见且现在居中于活动窗口，但提取宏不再起作用，我真的不确定原因。

我想知道是否有人能看一下这个问题，请告诉我我错在哪里。

非常感谢和问候

Chris

- IRHM

---

如果你在"For j = 1 To 1000"上设置一个断点，它会被调用吗？ - Steven

嗨@Steven，感谢您抽出时间回复我。不幸的是，这并没有改变事情。代码似乎在Initialize脚本中的.show上卡住了。顺祝商祺。Chris - IRHM

Answer 1

你遇到的问题是你将表格显示为模态框，这会停止后台代码的执行。

在表单属性中将ShowModal设置为false。

- Steven

---

嗨@Steven，谢谢你，这确实使表单居中了，谢谢。不幸的是，进度条不再在表单上滚动了。顺祝商祺。Chris - IRHM

Answer 2

我想发布我的可行解决方案，基于我已经编写的内容，我的同事完成了这个工作。

代码如下：

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

感谢您并致以亲切问候，

Chris

- IRHM