2016-09-14 2 views
1

У меня возникла проблема при создании и копировании диаграммы в vb6 с использованием excel. У меня есть этот следующий кодVBA Activechart.CopyPicture object defined error

Private Sub CreateChart(Optional ByVal ChartTitle As String _ 
       , Optional ByVal xAxis As Excel.Range _ 
       , Optional ByVal yAxis As Excel.Range _ 
       , Optional ByVal ColumnName As String _ 
       , Optional ByVal LegendPosition As XlLegendPosition = xlLegendPositionRight _ 
       , Optional ByVal rowIndex As Long = 2 _ 
       , Optional ByRef ChartType As String = xlLineMarkers _ 
       , Optional ByVal PlotAreaColorIndex As Long = 2 _ 
       , Optional ByVal isSetLegend As Boolean = False _ 
       , Optional ByVal isSetLegendStyle As Boolean = False _ 
       , Optional ByVal LegendStyleValue As Long = 1) 

Const constChartLeft = 64 
Const constChartHeight = 300 
Const constChartWidth = 700 

Dim xlChart As Excel.ChartObject 
Dim seriesCount As Long 
Dim ColorIndex As Long 
Dim marrayhold() As Variant 
Dim counter As Long 

Dim j As Long 


With mWorksheet 
    .Rows(rowIndex).RowHeight = constChartHeight 

    Set xlChart = .ChartObjects.Add(.Rows(rowIndex).Left, .Rows(rowIndex).Top, constChartWidth, constChartHeight) 
End With 

With xlChart.chart 
    .ChartType = ChartType 

    .SetSourceData Source:=yAxis, PlotBy:=xlRows 
    .SeriesCollection(1).XValues = xAxis 
    .HasTitle = True 

    .Legend.Position = LegendPosition 
    .Legend.Font.Size = 7.3 
    .Legend.Font.Bold = True 
    .Legend.Border.LineStyle = xlNone 
    .Legend.Border.ColorIndex = 1 

    .ChartTitle.Characters.Text = ChartTitle 
    .ChartTitle.Font.Bold = True 

    .Axes(xlValue).TickLabels.Font.Size = 8 ' yAxis Labels 
    .Axes(xlCategory).TickLabels.Font.Size = 8 ' xAxis Labels 

    .PlotArea.Interior.ColorIndex = PlotAreaColorIndex 
    .PlotArea.Interior.ColorIndex = 15 
    .PlotArea.Interior.PatternColorIndex = 1 
    .PlotArea.Interior.Pattern = xlSolid 
    xlChart.Name = "Chart 1" 
    Call Copy_Chart 
End With 
End Sub 

Существует функция для копирования графика и это, где происходит ошибка

Public Function Copy_Chart() 
With mWorksheet 
    .ChartObjects("Chart 1").Activate 
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, format:=xlPicture 
    .Paste 
    .ChartObjects("Chart 1").Delete 
End With 
End Function 

в строке ActiveChart.CopyPicture я получаю сообщение об ошибке, что сказал «приложение или объектная ошибка "Я пытался исследовать, но я не могу найти способ исправить эту ошибку.

ответ

1

Как всегда, вам следует избегать использования объектов Active*.

изменение

With mWorksheet 
    .ChartObjects("Chart 1").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
    .Paste 
    .ChartObjects("Chart 1").Delete 
End With 

Примечание, причина вы получили ошибку, вероятно, потому, что mWorksheet не был активен

+0

ошибка происходит потому, что 'метод ChartObject.CopyPicture' не имеет параметр 'Size', но объект 'Chart' * делает *. – ThunderFrame

+0

Ни OP, ни этот ответ не пытаются выполнить «ChartObject.CopyPicture». И код OPs _does_ работает, если 'mWorksheet' активен –

+0

Хм, действительно. Но использование CopyPicture в «ChartObject» позволяет избежать необходимости активировать «Рабочий лист», чтобы получить доступ к «Таблице». – ThunderFrame

0

Вы должны создать ссылку на ChartObject вместо активации и опираясь на активном ChartObject.

В 2013 году нет необходимости активировать лист, но имейте в виду доступ к свойству Chart - для этого потребуется активировать лист. См How do I reference charts with the same name, but on different worksheets?

Кроме того, метод CopyPicture не имеет аргумент с именем Size, так что вам нужно удалить Size:=xlScreen

Public Function Copy_Chart() 
    Dim mWorksheet 
    Set mWorksheet = Sheet1 
    If Not mWorksheet Is Nothing Then 
    With mWorksheet 
     .Activate 
     Dim cht As ChartObject 
     Set cht = .ChartObjects("Chart 1") 
     cht.CopyPicture Appearance:=xlScreen, Format:=xlPicture 
     .Paste 
     cht.Delete 
    End With 
    End If 
End Function 
Смежные вопросы