如何「更新」工作簿而不是重新打開它（使用VBA宏）？

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