添加图表对象时出现自动化错误

时间:2018-11-23 21:30:52

标签: excel vba charts

尝试在VBA中添加图表对象时出现自动化错误。奇怪的是,如果我尝试用更少的数据处理同一件事,则效果很好,但是如果数据数量增加(例如100行),则会产生自动化错误。根据调试器,问题似乎出在这一行:

Set Graph = ActiveSheet.ChartObjects.Add(Left:=400, Top:=100, Width:=390, Height:=250)

Run-time error 2147417848 800 10 108

这是完整的代码:

Sub Create_Framework()

    Dim Graph As ChartObject
    Dim Data As Range
    Dim SingleSheet As Worksheet

    Application.ScreenUpdating = False


    'Creating Net Columns
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("G2").Value = "Net Hedgers"
    Range("H2").Value = "Net Funds"


    'Net Hedgers Formula
    Range("G3").Select
    Do
        ActiveCell.Value = ActiveCell.Offset(0, -4).Value - ActiveCell.Offset(0, -3).Value
        ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell.Offset(0, -5).Value = 0


    'Net Funds Formula
    Range("H3").Select
    Do
        ActiveCell.Value = ActiveCell.Offset(0, -3).Value - ActiveCell.Offset(0, -2).Value
        ActiveCell.Offset(1, 0).Select
    Loop Until ActiveCell.Offset(0, -6).Value = 0

    'Alignment
    Columns("A:Z").HorizontalAlignment = xlCenter

    'Adding Other Sheets
    Worksheets.Add After:=Sheets(Sheets.Count), Count:=6


    'Renaming
    Worksheets(2).Name = "LHedgers"
    Worksheets(3).Name = "SHedgers"
    Worksheets(4).Name = "LFunds"
    Worksheets(5).Name = "SFunds"
    Worksheets(6).Name = "Net Hedgers"
    Worksheets(7).Name = "Net Funds"


    'Copy Data From Main Sheet To Created Sheets
    Worksheets(1).Activate
    Range("B2", Range("B2").End(xlDown).Offset(0, 7)).Select
    Selection.Copy

    For Each SingleSheet In Worksheets
        If SingleSheet.Name <> "Main" Then
            SingleSheet.Activate
            SingleSheet.Range("B2").PasteSpecial
            SingleSheet.Columns("A:Z").AutoFit
        End If
    Next SingleSheet


    'Move Data To Selected Rows
    For Each SingleSheet In Worksheets
        If SingleSheet.Name <> "Main" Then
            SingleSheet.Activate
            ActiveWindow.DisplayGridlines = False
            Range("B2", Range("B2").End(xlDown).Offset(0, 7)).Cut Range("B25")
            Cells.Select
            Selection.Font.Size = 10
            Selection.Font.Name = "Calibri Light"
        End If
    Next SingleSheet


    'Draw Charts & AutoFit Them
    Sheets(2).Activate
    Set Graph = ActiveSheet.ChartObjects.Add(Left:=400, Top:=100, Width:=390, Height:=250)
    Graph.Chart.SetSourceData Source:=Union(Range("C26", Range("C26").End(xlDown)), Range("I26", Range("I26").End(xlDown)))
    Graph.Chart.SeriesCollection(2).AxisGroup = xlSecondary
    Graph.Chart.HasAxis(xlCategory, xlSecondary) = True
    Graph.Chart.ChartType = xlLine

0 个答案:

没有答案