2017-02-21 13 views
6

接頭辞:私のコードでは、内部にDBがあり、組織全体には見えないような情報が入ったDBがあります。私は外部のブックを開き、PivotTableからすべてのデータを正常に取得することができます。2番目のワークブック(同じインスタンス)を開くときに画面がちらつくのを防ぎます。

問題:コードが実行されると、画面が約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 
+0

ちょっとした回避策のアイデア - 大きなモードレスのユーザーフォームをアクティブにする方法はありますか?その後、ちらつきはバックグラウンドにとどまります。 – Vityata

+0

また別の考え方 - BudgetWBを開いている間にExcelアプリケーション全体を見えないように設定する - 'application.Visible = false'を開き、それを元に戻してください。 – Vityata

+0

@Vityata私は2番目のExcelインスタンスを開こうとしません –

答えて

3

は、画面のちらつきを最小限に抑えるために、私は次のように動作するはずだと思います。一度ScreenUpdatingをオフにすると、可視ウィンドウをリセットする前にワークブックを開いたり隠すことができるようになると、ActiveWindowを非表示にするという追加のステップが追加されています。試してみると、リボンは非アクティブになってアクティブになるように見えますが、スプレッドシートはちらつきのない状態です。あなたがそれを好きならば、うまくいくこと、周りに別の仕事

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 
+0

これは改良されたものですが、scrrenはまだfilckerですが、縮小されています。すべてのアイデアはどのようにちらつきを完全に排除するには? –

+0

私がやった試行や研究からは可能かどうかはわかりません。私は、ファイルを開く前にイベントを無効にすると、ちらつき時間が短くなる傾向があることがわかりました。 (これを優先的に使用して、アクティブウィンドウを非表示に設定すると、最良の結果が得られました) – Tragamor

+0

ありがとう:)それはすべてのちらつきを取り除いていませんでしたが、 "ぶら下げ"画面が大幅に減少しました! –

0

...これはあなたのための改善のに十分であるかわかりません。ピボットテーブルを使用してシートをブックにコピーし、そこから作業するという考えがあります。シートを非表示にして、作業の準備ができたら削除します。

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 
関連する問題