要求保存并关闭从属的辅助excel工作簿，然后才能使用VBA关闭主工作簿

我是VBA的新手，正在寻求帮助。我有一个仪表板，可以访问用户输入信息的辅助文件。我想知道是否有任何方法可以要求在关闭已启动的原始仪表板之前关闭辅助工作簿

例如：在FPA_Opportunities_v6.xlsm关闭时，如果CCC_Error_Tracker.xlsm当前处于活动状态，则需要先关闭CCC_Error_Tracker.xlsm，然后才能关闭FPA_Opportunities_v6.xlsm

我希望关闭的文件位于“Supporting\u Files\CCC\u Error\u Tracker.xlsm” 用户启动的主仪表板位于：\\\Opportunities\u dashboard\FPA\u Opportunities\u v6.xlsm

现在，我已经将其设置到可以检测我的FPA_Opportunities_v6.xlsm仪表板是否为只读的位置，因为只有团队领导才能对此进行更改。向用户提供的响应是“授权队长未进行任何更改”。如果对CCS_错误_跟踪器进行了更改，并提示您的更改已保存，则可以继续。请关闭该窗口以保存设置。“

如果可能的话，我宁愿不要混淆最终用户。简单的解决方案是必须要求关闭。有什么想法吗？我觉得这对其他用户也有好处

       Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Sheets("START").Visible = xlSheetVisible
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "START" Then
ws.Visible = xlVeryHidden
End If
Next ws
CodeRetry:
     On Error GoTo Failed
        If Me.Saved = True And BackupReqd = False Then Exit Sub
    Dim sDateTime As String, sFileName As String
    With ThisWorkbook
        sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
        sFileName = Replace(.Name, ".xlsm", sDateTime)
        .SaveCopyAs Filename:="P:\WI\Teams\Programs\J&J CCC\CHC & Skincare\Care Specialist\Alicia's Team\FPA RESULTS\Supporting_Files\FPA_FILE_BACKUPS\Opportunities_Dashboard\" & sFileName

     GoTo Passed

Failed:
 GoTo CodeRetry

 Exit Sub
Passed:
    Application.DisplayAlerts = False
    If ThisWorkbook.ReadOnly = True Then GoTo Passed2

    GoTo Passed3

Passed2:
    If IsWorkbookOpen("P:\WI\Teams\Programs\J&J CCC\CHC & Skincare\Care Specialist\Alicia's Team\FPA RESULTS\Supporting_Files\CCC_Error_Tracker.xlsm") Then
    MsgBox "Excel has detected that your `Team Error Tracker` is still open and not been saved. The opportunities Dashboard will be closing but please remember in order to save your data you must close CCC_Error_Tracker.", vbInformation
    End If
    GoTo End1
Passed3:
ThisWorkbook.Save
MsgBox "Your data has been saved and backed-up successfully! Your backup will be stored for 72 hours before discarded to save disk space. Email chrischm@altaresources.com if you have a suggestion."
End1:
End With
End Sub
Function IsWorkbookOpen(workbookName As String)
Dim ret As Boolean
ret = False
On Error Resume Next
    For Each wb In Application.Workbooks
        If wb.Name = workbookName Then
            ret = True
            GoTo EarlyExit
        End If
    Next
On Error GoTo 0
EarlyExit:
    IsWorkbookOpen = ret
End Function

Private子工作簿\u关闭前（取消为布尔值）
将ws设置为工作表
图纸（“开始”）。可见=xlSheetVisible
对于此工作簿中的每个ws。工作表
如果ws.Name为“START”，那么
ws.Visible=xlVeryHidden
如果结束
下一个ws
代码重试：
在发生错误时，转到失败
如果Me.Saved=True且BackupReqd=False，则退出Sub
Dim sDateTime为字符串，sFileName为字符串
使用此工作簿
sDateTime=“（”和格式（现在是“yyyy-mm-dd-hhmm”）和“.xlsm”
sFileName=Replace（.Name，.xlsm，.sDateTime）
.SaveCopyAs文件名：=“P:\WI\Teams\Programs\J&J CCC\CHC&Skincare\Care Specialist\Alicia's Team\FPA结果\Supporting\U Files\FPA\U FILE\U Backup\Opportunities\U Dashboard\”&sFileName
后藤通过
失败：
转到代码重试
出口接头
通过：
Application.DisplayAlerts=False
如果ThisWorkbook.ReadOnly=True，则转到Passed2
转到过去3
通过2：
如果工作簿打开（“P:\WI\Teams\Programs\J&J CCC\CHC&Skincare\Care Specialist\Alicia's Team\FPA RESULTS\Supporting_Files\CCC_Error_Tracker.xlsm”），则
MsgBox“Excel检测到您的“团队错误跟踪器”仍处于打开状态，尚未保存。opportunities仪表板将关闭，但请记住，为了保存数据，您必须关闭CCC_Error_Tracker。“，vbInformation
如果结束
转到End1
通过3：
此工作簿。保存
MsgBox“您的数据已成功保存和备份！您的备份将存储72小时，然后丢弃以节省磁盘空间。电子邮件chrischm@altaresources.com如果你有建议的话。”
完一:
以
端接头
函数IsWorkbookOpen（workbookName为字符串）
Dim ret作为布尔值
ret=假
出错时继续下一步
对于应用程序中的每个wb。工作簿
如果wb.Name=workbookName，则
ret=真
去早退
如果结束
下一个
错误转到0
提前退出：
IsWorkbookOpen=ret
端函数

---

让我知道是否还有其他帮助他人的方法。我希望尽可能准确。请提供任何提示，谢谢。

测试一本书是否已关闭的简单方法是测试它是否已不再打开

此函数将检查工作簿（由名称指定）是否已打开，并返回布尔值True或False，您可以在代码逻辑中使用该值检查工作簿是否仍处于打开状态

例如：

If IsWorkbookOpen("FPA_Opportunities_v6.xlsm") Then
    MsgBox "A message box to let the user know they need to save & close first..., etc.", vbInformation
End If

以下是函数：

Function IsWorkbookOpen(workbookName as String)
Dim ret as Boolean
ret = False
On Error Resume Next
    For each wb in Application.Workbooks
        If wb.Name = workbookName Then
            ret = True
            GoTo EarlyExit
        End If
    Next
On Error GoTo 0
EarlyExit:
    IsWorkbookOpen = ret
End Function

---

确保将函数放在子模块之外，紧跟在

结束子模块之后就可以了，或者您可以将它放在
子模块之前…
，或者您可以根据需要将它放在不同的模块中。
您当前的代码只检查本地计算机上的当前实例，该文件可能在另一个实例中打开，或者在另一台计算机上打开计算机替代器

下面的代码（信用）测试文件是否在任何机器上打开

输入要检查的完整文件路径

即
S:\Opportunities\u Dashboard\FPA\u Opportunities\u v6.xlsm

文件测试

检查功能

您的代码的其余部分在哪里？我已经提供了上面的示例。非常感谢。因此，基本上，如果我想要“CCC_Error_Tracker.xlsm”，那么我会将其放在您的示例中？是的，当然。更好的是，如果您在仪表板模块的范围内有一个变量或者过程，您可以使用变量而不是硬编码文件名。我对此有一些困难。它试图说end sub而不是end if？编译错误？您需要更新您的原始问题以显示您当前尝试实现的代码。我认为代码中没有任何内容（如我在答复中所述）这会引发这种性质的编译错误。我在示例中说明了我希望它去哪里，但我有点困惑，正如前面所说的，我对此非常陌生，所以我在学习。我更新了我希望它在哪里播放。我仍然希望它周围的一切都能发生。我希望该函数只在导致通过2的情况下才会发生如果有意义的话就发生。
Sub CheckWb()
If IsFileOpen("C:\temp\checka.xlsm") Then MsgBox "File open somewhere .....", vbInformation
End Sub

Private Function IsFileOpen(FileName As String) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsFileOpen
' By Chip Pearson www.cpearson.com/excel chip@cpearson.com
' This function determines whether a file is open by any program. Returns TRUE or FALSE
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FileNum As Integer
Dim ErrNum As Integer

On Error Resume Next   ' Turn error checking off.

'''''''''''''''''''''''''''''''''''''''''''
' If we were passed in an empty string,
' there is no file to test so return FALSE.
'''''''''''''''''''''''''''''''''''''''''''
If FileName = vbNullString Then
    IsFileOpen = False
    Exit Function
End If

'''''''''''''''''''''''''''''''
' If the file doesn't exist,
' it isn't open so get out now.
'''''''''''''''''''''''''''''''
If Dir(FileName) = vbNullString Then
    IsFileOpen = False
    Exit Function
End If
''''''''''''''''''''''''''
' Get a free file number.
''''''''''''''''''''''''''
FileNum = FreeFile()
'''''''''''''''''''''''''''
' Attempt to open the file
' and lock it.
'''''''''''''''''''''''''''
Err.Clear
Open FileName For Input Lock Read As #FileNum
''''''''''''''''''''''''''''''''''''''
' Save the error number that occurred.
''''''''''''''''''''''''''''''''''''''
ErrNum = Err.Number
On Error GoTo 0        ' Turn error checking back on.
Close #FileNum       ' Close the file.
''''''''''''''''''''''''''''''''''''
' Check to see which error occurred.
''''''''''''''''''''''''''''''''''''
Select Case ErrNum
    Case 0
    '''''''''''''''''''''''''''''''''''''''''''
    ' No error occurred.
    ' File is NOT already open by another user.
    '''''''''''''''''''''''''''''''''''''''''''
        IsFileOpen = False

    Case 70
    '''''''''''''''''''''''''''''''''''''''''''
    ' Error number for "Permission Denied."
    ' File is already opened by another user.
    '''''''''''''''''''''''''''''''''''''''''''
        IsFileOpen = True

    '''''''''''''''''''''''''''''''''''''''''''
    ' Another error occurred. Assume the file
    ' cannot be accessed.
    '''''''''''''''''''''''''''''''''''''''''''
    Case Else
        IsFileOpen = True

End Select

End Function