在工作簿之间复制和粘贴时消除 VBA Excel 中的屏幕闪烁
Eliminating Screen Flickering in VBA Excel when Copying and Pasting Between Workbooks
我制作了一个宏,用于从报表工作簿中复制某些数据并将其粘贴到摘要工作簿中。从功能上讲,宏工作得很好,但是当数据在工作簿之间移动时,我看到了 'flickering' 效果。我已经尝试了很多消除它的技巧(见代码),但它仍然闪烁!关于如何消除它或可能导致它的任何建议?
我参考了 this similar question 但它对我的情况不起作用。
这是我的代码的一个略微简化的版本。我想我已经包含了可能与此问题相关的所有部分,但如果有任何不合理之处请告诉我。
Sub GetInfo()
'This macro copies and pastes certain information from a
'report of a fixed format into a summary with a 'nicer' format.
'Variables
Dim xReport As Workbook
Dim xSummary As Workbook
Dim xReportSheet As Worksheet
Dim xSummarySheet As Worksheet
Dim rng As Range
'Initilizations
Set xSummary = Workbooks("Summary")
Set xSummarySheet = xSummary.ActiveSheet
Set xReport = Workbooks.Open(xFilePath)
Set xReportSheet = xReport.ActiveSheet
'Turn Off Window Flickering (but it doesn't work)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
'Format info in each workbook.
With xSummary
With xSummarySheet
'Do some initial formatting to workbook prior to pasting info.
End With
End With
With xReport
With xReportSheet
'Do some formatting on the info before copying.
End With
End With
'Copy and Paste Data between workbooks.
'Copy
With xReport
With xReportSheet
Set rng = .Cells(2,5)
Application.CutCopyMode = False
rng.Copy
End With
End With
'Paste
With xSummary
With xSummarySheet
Set rng = .Cells(3,1)
rng.PasteSpecial Paste:=xlpasteValues
End With
End With
'Copy and Paste a few more times
'...
'...
'...
'Return to normal
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
End Sub
谢谢
不需要双重嵌套的With
语句。您一次只能使用 1 个 With...End With
语句(好吧,您实际上可以 限定 一个新的 With
语句使用先前的 with 语句,但您没有这样做所以在这种情况下)。不管怎样,那不是你的问题。
尝试看看避免 copy/paste 是否会满足您的需要。
替换所有这些:
'Copy and Paste Data between workbooks.
'Copy
With xReport
With xReportSheet
Set rng = .Cells(2,5)
Application.CutCopyMode = False
rng.Copy
End With
End With
'Paste
With xSummary
With xSummarySheet
Set rng = .Cells(3,1)
rng.PasteSpecial Paste:=xlpasteValues
End With
End With
使用这行代码:
xSummarySheet.Cells(3, 1) = xReportSheet.Cells(2, 5).Value
如果不出意外,我相信您的代码至少 运行 会快得多。
此外,不确定您使用的是 .Activate
还是 .Select
。如果是,请不要。
我制作了一个宏,用于从报表工作簿中复制某些数据并将其粘贴到摘要工作簿中。从功能上讲,宏工作得很好,但是当数据在工作簿之间移动时,我看到了 'flickering' 效果。我已经尝试了很多消除它的技巧(见代码),但它仍然闪烁!关于如何消除它或可能导致它的任何建议?
我参考了 this similar question 但它对我的情况不起作用。
这是我的代码的一个略微简化的版本。我想我已经包含了可能与此问题相关的所有部分,但如果有任何不合理之处请告诉我。
Sub GetInfo()
'This macro copies and pastes certain information from a
'report of a fixed format into a summary with a 'nicer' format.
'Variables
Dim xReport As Workbook
Dim xSummary As Workbook
Dim xReportSheet As Worksheet
Dim xSummarySheet As Worksheet
Dim rng As Range
'Initilizations
Set xSummary = Workbooks("Summary")
Set xSummarySheet = xSummary.ActiveSheet
Set xReport = Workbooks.Open(xFilePath)
Set xReportSheet = xReport.ActiveSheet
'Turn Off Window Flickering (but it doesn't work)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
'Format info in each workbook.
With xSummary
With xSummarySheet
'Do some initial formatting to workbook prior to pasting info.
End With
End With
With xReport
With xReportSheet
'Do some formatting on the info before copying.
End With
End With
'Copy and Paste Data between workbooks.
'Copy
With xReport
With xReportSheet
Set rng = .Cells(2,5)
Application.CutCopyMode = False
rng.Copy
End With
End With
'Paste
With xSummary
With xSummarySheet
Set rng = .Cells(3,1)
rng.PasteSpecial Paste:=xlpasteValues
End With
End With
'Copy and Paste a few more times
'...
'...
'...
'Return to normal
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
End Sub
谢谢
不需要双重嵌套的With
语句。您一次只能使用 1 个 With...End With
语句(好吧,您实际上可以 限定 一个新的 With
语句使用先前的 with 语句,但您没有这样做所以在这种情况下)。不管怎样,那不是你的问题。
尝试看看避免 copy/paste 是否会满足您的需要。
替换所有这些:
'Copy and Paste Data between workbooks.
'Copy
With xReport
With xReportSheet
Set rng = .Cells(2,5)
Application.CutCopyMode = False
rng.Copy
End With
End With
'Paste
With xSummary
With xSummarySheet
Set rng = .Cells(3,1)
rng.PasteSpecial Paste:=xlpasteValues
End With
End With
使用这行代码:
xSummarySheet.Cells(3, 1) = xReportSheet.Cells(2, 5).Value
如果不出意外,我相信您的代码至少 运行 会快得多。
此外,不确定您使用的是 .Activate
还是 .Select
。如果是,请不要。