Устранение мерцания экрана в VBA Excel при копировании и вставке между книгами - PullRequest
Новая
       24

Устранение мерцания экрана в VBA Excel при копировании и вставке между книгами

0 голосов
/ 17 октября 2018

Я создал макрос для копирования определенных данных из рабочей книги отчета и вставки их в сводную рабочую книгу.Функционально макрос работает отлично, но я вижу эффект «мерцания», когда данные перемещаются между книгами.Я попробовал несколько приемов для его устранения (см. Код), но он все еще мерцает!Любые предложения о том, как это устранить, или что может быть причиной?

Я упомянул этот похожий вопрос , но он не работал для моего случая.

Вот несколько сокращенная версия моего кода.Я думаю, что я включил все разделы, которые могут быть связаны с этой проблемой, но дайте мне знать, если что-то не имеет смысла. 

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

Спасибо

1 Ответ

0 голосов
/ 17 октября 2018

Двойные вложенные операторы With не нужны.Вы можете использовать только 1 With...End With оператор за раз (ну, на самом деле, вы можете квалифицировать новый With оператор, используя предыдущий оператор 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

этимодна строка кода: 

xSummarySheet.Cells(3, 1) = xReportSheet.Cells(2, 5).Value

Если ничего другого, я уверен, что ваш код по крайней мере будет работать намного быстрее.

Кроме того, не уверен, используете ли вы .Activate или .Select.Если да, не надо.

...