Альтернативный способ скопировать объекты диаграммы и вставить их как изображения без мерцания окна VBA Excel - PullRequest
0 голосов
/ 17 октября 2018

Я хотел бы «скопировать» объекты диаграммы из одной рабочей книги и «вставить» их в другую рабочую книгу в виде рисунка без «мерцания» окна.Кажется, что независимо от того, какие строки я добавляю, например Application.ScreenUpdating = False и т. Д., Мерцание экрана не исчезнет, ​​если я использую команды копирования / вставки или выбора / активации.

Ранее В макросе яперемещать значения ячеек между двумя рабочими книгами.Я могу избежать использования команд копирования / вставки и выбора / активации и, таким образом, мерцания экрана, в этом случае используя строку типа: xSummarySheet.Cells(3, 1) = xReportSheet.Cells(4, 10).Value, но я не уверен, как это сделать для объектов диаграммы и, тем более, типаприведите диаграмму как изображение в процессе.

Вот сокращенный пример кода, который работает так, как я хочу, но дает мерцание окна.

Sub movecharts()

'Stop Flickering... sort of
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False

'Variables    
Dim xReportSheet As Worksheet
Dim xSummarySheet As Worksheet
Dim xChart1 As ChartObject
Dim xChart2 As ChartObject
'Dim more chart objects

'Initializations
Set xReportSheet = Workbooks.Open(xFilePath).ActiveSheet
Set xSummarySheet = Workbooks.Open(xFilePath2).ActiveSheet
Set xChart1 = xReportSheet.ChartObjects("Chart 1")
Set xChart2 = xReportSheet.ChartObjects("Chart 2")
'Set more charts 

'Move Values
    xSummarySheet.Cells(3, 1) = xReportSheet.Cells(4, 10).Value
    xSummarySheet.Cells(3, 2) = xReportSheet.Cells(3, 5).Value
    'Move More Values

'Move Charts
    'Move Chart 1
    Application.CutCopyMode = False
    xChart1.Chart.ChartArea.Copy
    xSummarySheet.Cells(3, 12).Select
    xSummarySheet.Pictures.Paste.Select

    'Move Chart 2
    Application.CutCopyMode = False
    xChart2.Chart.ChartArea.Copy
    xSummarySheet.Cells(3,13).Select
    xSummarySheet.Pictures.Paste.Select

    'Move more charts

'Restore Settings
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True

End Sub

Спасибо зазаранее за вашу помощь!Любой совет действительно ценится.

...