открытия/закрытия рабочей книги и Обновить соединения

Question

У меня есть две книги на общем сетевом диске:

• Учебное пособие А (таблица)
• Учебное пособие В (Сводная таблица -связных к источнику Workbook A)

Я пытаюсь, когда открыт Workbook B, запустить макрос и сделать это:

1. Unprotect определенный рабочий лист на Workbook B
2. Если рабочая книга А Open, обновить подключения к данным на рабочих книги B
3. Если рабочая книга замкнутость, открытый Рабочий и обновить подключения к данным на рабочих книги B, затем закрыть учебное пособие А.
4. Protect определенной таблицы на Workbook B

Приведенный ниже код работает в большинстве сценариев при тестировании до сих пор, но если кто-то пытается открыть книгу B на своем компьютере, когда у кого-то есть рабочая книга A, открытая на другом компьютере, она открывает книгу A как прочитанную - только файл и держит его открытым на своем компьютере. Мне нужно, чтобы он закрылся на своем компьютере и сохранил первоначальный доступ, который находится на другом компьютере.

Public Sub RefreshPvt() 
ThisWorkbook.Worksheets("Sheet1").Unprotect 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

Dim wkb As Workbook 

If IsFileOpen("S:\\Testing\Job Closeout Status Test.xlsx") Then 
    ThisWorkbook.RefreshAll 
Else 
Set wkb = Workbooks.Open(filename:="S:\\Testing\Job Closeout Status Test.xlsx") 
ThisWorkbook.RefreshAll 
wkb.Close SaveChanges:=False 
End If 

ThisWorkbook.Worksheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ 
     , AllowFormattingCells:=True, AllowFormattingColumns:=True, _ 
     AllowFormattingRows:=True 

Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
End Sub 


Function IsFileOpen(filename As String) 
    Dim filenum As Integer, errnum As Integer 

    On Error Resume Next ' Turn error checking off. 
    filenum = FreeFile() ' Get a free file number. 
    ' Attempt to open the file and lock it. 
    Open filename For Input Lock Read As #filenum 
    Close filenum   ' Close the file. 
    errnum = Err   ' Save the error number that occurred. 
    On Error GoTo 0  ' Turn error checking back on. 

    ' Check to see which error occurred. 
    Select Case errnum 

     ' No error occurred. 
     ' File is NOT already open by another user. 
     Case 0 
     IsFileOpen = False 

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

     ' Another error occurred. 
     Case Else 
      Error errnum 
    End Select 

End Function 

Answer 1

если вы запустите ThisWorkbook.RefreshAll на рабочей кабине B в непосредственном окне это работает?

Вы также могли бы сделать XLApp.Visible = верно ли или нет это открытие

Я думаю, вы должны использовать что-то подобное:

Dim pt As PivotTable 
For Each pt In ActiveSheet.PivotTables 

    pt.RefreshTable 

Next pt 

Чтобы сделать всю книгу вы можете использовать:

Sub AllWorkbookPivots() 
Dim pt As PivotTable 
Dim ws As Worksheet 

    For Each ws In ActiveWorkbook.Worksheets 

     For Each pt In ws.PivotTables 
      pt.RefreshTable 
     Next pt 
    Next ws 

End Sub