VBA 在活动屏幕上居中用户表单

Question

不知是否有人可以帮助我。

我正在使用下面的 'Extract' 代码，它在单击按钮时运行，正如您可能看到的那样，它还会初始化一个带有滚动进度条的 '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

因为我使用的是双显示器，所以我一直在研究如何将启动画面置于“活动 Window”的中心，并且许多帖子之一让我使用了以下代码：

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

我现在遇到的问题是，虽然 'Splash' 屏幕是可见的并且现在以活动 window 为中心，但提取宏不再有效，我真的不确定为什么。

我只是想知道是否有人可以看看这个，让我知道我哪里做错了。

非常感谢和亲切的问候

克里斯

Answer 1

您遇到的问题是您将表单显示为模式，这会停止后台代码执行。

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

Answer 2

我只是想 post 我的工作解决方案，它建立在我已经编写的内容之上，一位同事能够完成。

代码如下：

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

非常感谢和亲切的问候

克里斯

VBA 在活动屏幕上居中用户表单

VBA Centre Userform On Active Screen

excel

vba

excel-2013