防止屏幕在打開第二個工作簿時閃爍（同一實例）

Question

前綴：我的代碼打開一個外部工作簿，其中包含一些對整個組織不可見的信息。我可以打開外部工作簿，併成功從PivotTable中檢索所有數據。

問題：當我的代碼運行時，屏幕閃爍約0.5秒以顯示其他工作簿。

目標：在工作簿之間切換時，屏幕上不會有任何閃爍。

我的代碼（相關部分）：

Option Explicit 

Public Sub GetBudgetData_fromPivotTable(Budget_ShtName As String, Budget_PvtName As String) 

Dim BudgetWB       As Workbook 
Dim PvtTbl        As PivotTable 
Dim pvtFld        As PivotField 
Dim strPvtFld       As String 
Dim prjName        As String 

' ****** This is the Section I am trying to prevent from the screen to flicker ****** 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

' read budget file parameters 
Set BudgetWB = Workbooks.Open(BudgetFile_Folder & BudgetFile_wbName) 

BudgetWB.Windows(1).Visible = False 
OriginalWB.Activate ' <-- this is the original workbook that is calling the routine 

Set PvtTbl = BudgetWB.Worksheets(Budget_ShtName).PivotTables(Budget_PvtName) 

' a lot of un-relevant code line 

BudgetWB.Close (False) ' close budget file 
OriginalWB.Activate 

' restore settings 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

End Sub 

Answer 1

爲了最大限度地減少屏幕閃爍，我認爲以下應工作;它添加了隱藏ActiveWindow的一個步驟，一旦關閉ScreenUpdating以允許在重置可見性級別之前打開和隱藏工作簿。當我嘗試它時，功能區似乎停用並激活，但電子表格保持無閃爍。不知道這是否足以對您有所改進...

Public Sub GetBudgetData_fromPivotTable(Budget_ShtName As String, Budget_PvtName As String) 

    Dim BudgetWB       As Workbook 
    Dim PvtTbl        As PivotTable 
    Dim pvtFld        As PivotField 
    Dim strPvtFld       As String 
    Dim prjName        As String 

    ' ****** This is the Section I am trying to prevent from the screen to flicker ****** 
    Dim wbWindow As Window: Set wbWindow = ActiveWindow 
    ' Freeze current screen 
    Application.ScreenUpdating = False 
    wbWindow.Visible = False 

    ' read budget file parameters 
    Set BudgetWB = Workbooks.Open(BudgetFile_Folder & BudgetFile_wbName) 
    BudgetWB.Windows(1).Visible = False 

    ' Reset current screen 
    wbWindow.Visible = True 
    Application.ScreenUpdating = True 

    OriginalWB.Activate ' <-- this is the original workbook that is calling the routine 

    Set PvtTbl = BudgetWB.Worksheets(Budget_ShtName).PivotTables(Budget_PvtName) 

    ' a lot of un-relevant code line 

    BudgetWB.Close (False) ' close budget file 
    OriginalWB.Activate 

    ' restore settings 
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 

End Sub 

Answer 2

另一個解決方法是，如果你喜歡它，那將起作用。這個想法是，您將工作簿中的透視表複製到工作表中，然後從那裏開始工作。將工作表隱藏起來，一旦準備好工作 - 刪除它。

Option Explicit 

Sub ImportSheet() 

    Dim wbBk   As Workbook 
    Dim wsSht   As Worksheet 
    Dim sImportFile  As String 
    Dim sFile   As String 
    Dim sThisBk   As Workbook 
    Dim vfilename  As Variant 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 

    Set sThisBk = ActiveWorkbook 
    sImportFile = Application.GetOpenFilename(_ 
    FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook") 

    vfilename = Split(sImportFile, "\") 
    sFile = vfilename(UBound(vfilename)) 
    Application.Workbooks.Open Filename:=sImportFile 

    Set wbBk = Workbooks(sFile) 
    If SheetExists("MyPivotData") Then 
     Set wsSht = wbBk.Sheets("MyPivotData") 
     wsSht.Copy 
     ThisWorkbook.Sheets("MyPivotData").Visible = xlSheetVeryHidden 
    End If 

    'do your work 
    'then delete the added sheet 

    wbBk.Close SaveChanges:=False 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 

End Sub 

Private Function SheetExists(sWSName As String) As Boolean 

    Dim ws As Worksheet 
    On Error Resume Next 
    Set ws = Worksheets(sWSName) 
    If Not ws Is Nothing Then SheetExists = True 

End Function