Как «обновить» книгу вместо ее повторного открытия (используя макросы 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 

EDIT: Если вы действительно хотите, чтобы сходить с ума, вы можете использовать эту функцию, которая проверяет, существует ли файл, и возвращает 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