Jak "zaktualizować" skoroszyt zamiast go ponownie otworzyć (używając makr VBA)?

Question

Mam problemy z moim kodzie poniżej:

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 
... 

Jak widać, to otwiera się za każdym skoroszytu dwukrotnym kliknięciu pewną komórkę. Problemem jest: Po raz drugi dwukrotnym kliknięciu Dostaję irytujący komunikat: „« Filename.xlsx»jest już otwarty Wznowienie spowoduje żadnych zmian wprowadzonych do wyrzucenia ...”

¿Jak mogę wyłączyć tę wiadomość (ponieważ nie wprowadzono żadnych zmian), a jeśli to możliwe, sprawić, że skoroszyt docelowy zostanie "zaktualizowany" po każdym dwukrotnym kliknięciu zamiast "ponownego otwarcia"?

Answer 1

Można użyć funkcji, aby sprawdzić, czy jest już otwarty:

Function WorkbookIsOpen(wb_name As String) As Boolean 

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

Następnie w procedurze nazwać tak:

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: Jeśli naprawdę chcesz zaszaleć, możesz użyć tej funkcji, która sprawdza, czy plik istnieje, i zwraca Nothing, jeśli nie istnieje, w przeciwnym razie zwraca wartość Workbook, nieznacznie rozwijając powyższą logikę:

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 

Oprócz funkcji WorkbookIsOpen powyżej, używa tego:

Function FileExists(strFileName As String) As Boolean 

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

Można to wykorzystać w swojej procedurze jak:

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