Question

我的以下代码出现问题：

Private Sub Worksheet_BeforeDoubleClick(ByVal...
Application.ScreenUpdating = False
Set wbks = Workbooks.Open("\\whatever\whatever.xlsx")           
wbks.Sheets("Control").Activate
ActiveSheet.Range("A3").Select 
Application.ScreenUpdating = True
...

正如您所看到的，每次双击某个单元格时，它都会打开一个工作簿。问题是：在我第二次双击后，我收到了令人讨厌的消息：

“'Filename.xlsx'已经打开。重新打开会导致您所做的任何更改被丢弃......”

¿如何关闭此消息（因为未进行任何更改），如果可能，在每次双击而不是“重新打开”后使目标工作簿“更新”？

Answer 1

您可以使用某个功能检查它是否已经打开：

Function WorkbookIsOpen(wb_name As String) As Boolean

On Error Resume Next
WorkbookIsOpen = CBool(Len(Workbooks(wb_name).Name) > 0)
End Function

然后在你的程序中，这样称呼它：

Private Sub Worksheet_BeforeDoubleClick(ByVal...
Application.ScreenUpdating = False
If WorkbookIsOpen("whatever.xlsx") then
    Set wbks = Workbooks("whatever.xlsx")
Else
    Set wbks = Workbooks.Open("\\whatever\whatever.xlsx")
End If      
wbks.Sheets("Control").Activate
ActiveSheet.Range("A3").Select 
Application.ScreenUpdating = True

编辑：如果你真的想发疯，你可以使用这个函数检查文件是否存在，如果不存在则返回Nothing，否则返回Workbook，稍微扩展上面的逻辑：

Function GetWorkbook(WbFullName As String) As Excel.Workbook

'checks whether workbook exists
'if no, returns nothing
'if yes and already open, returns wb
'if yes and not open, opens and returns workbook
Dim WbName As String

WbName = Mid(WbFullName, InStrRev(WbFullName, Application.PathSeparator) + 1)
If Not WorkbookIsOpen(WbName) Then
    If FileExists(WbFullName) Then
        Set GetWorkbook = Workbooks.Open(Filename:=WbFullName, UpdateLinks:=False, ReadOnly:=True)
    Else
        Set GetWorkbook = Nothing
    End If
Else
    Set GetWorkbook = Workbooks(WbName)
End If
End Function

除了上面的WorkbookIsOpen函数，它还使用了这个函数：

Function FileExists(strFileName As String) As Boolean

If Dir(pathname:=strFileName, Attributes:=vbNormal) <> "" Then
    FileExists = True
End If
End Function

您可以在以下程序中使用此功能：

Private Sub Worksheet_BeforeDoubleClick(ByVal...
Application.ScreenUpdating = False
Set wbks = GetWorkbook("\\whatever\whatever.xlsx")
If wbks is Nothing Then
    MsgBox "That's funny, it was just here"
    'exit sub gracefully
End If
wbks.Sheets("Control").Activate
ActiveSheet.Range("A3").Select 
Application.ScreenUpdating = True

如何“更新”工作簿而不是重新打开它（使用VBA宏）？

1 个答案: