与excel中的股票图表有些奇怪

时间:2012-03-09 17:26:17

标签: charts excel-vba excel-2007 vba excel

我在excel中有一个VBA代码,它会自动创建agraph并对其进行格式化,然后粘贴到图表excel表中。代码似乎适用于除股票图表之外的所有图表。每当我运行宏时,我都可以看到图表创建,但是当涉及格式化和特殊粘贴时,图形变为不可见。换句话说,当代码完成运行时,我无法看到图形。

我不知道股票图表发生了什么?任何人都可以解释并告诉我解决方案吗? 非常感谢。

这是我的代码:

Sub CreateGraph()
Dim MyRng As Range
Dim LastCell As Long
LastCell = Worksheets(1).Range("E3").End(xlDown).Row
Set MyRng = Worksheets(1).Range("B3:E" & LastCell)
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=MyRng
    ActiveChart.ChartType = xlStockHLC
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Chart1"
End Sub

Sub FormatChart()
Let Title = Sheets("Sheet1").Cells(2, 1)
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.ChartTitle.Text = Title & "responses*"
    With ActiveChart.ChartTitle.Font
    .Name = "Arial"
    .FontStyle = "Bold"
    .Size = 8
    End With
    With ActiveChart.Axes(xlCategory).TickLabels.Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 7
    End With
    With ActiveChart.Axes(xlValue).TickLabels.Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 7
    End With
    With ActiveChart.PlotArea.Interior
    .ColorIndex = 2
    .PatternColorIndex = 1
    .Pattern = xlSolid
    End With
    Range("S4").Select
    ActiveWindow.SmallScroll Down:=48
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Legend.Select
    With ActiveChart.Legend.Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 8
    End With
    ActiveWindow.SmallScroll Down:=45
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.PlotArea.Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWindow.SmallScroll Down:=-45
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWindow.SmallScroll Down:=-54
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Width = 500
    ActiveChart.ChartArea.Height = 1000
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Axes(xlValue).Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).MinimumScale = 0
    ActiveChart.Axes(xlValue).MaximumScale = 100
    ActiveChart.Axes(xlValue).MajorUnit = 20
    ActiveChart.Axes(xlValue).MajorUnit = 10
        With ActiveChart.SeriesCollection(1)
        .Interior.Color = RGB(0, 51, 153)
    End With
            With ActiveChart.SeriesCollection(2)
        .Interior.Color = RGB(80, 116, 77)
    End With
        ActiveSheet.ChartObjects("Chart 1").Activate
        ActiveSheet.ChartObjects("Chart 1").Activate
    Selection.Cut
    Sheets("Chart2").Select
    ActiveChart.Paste
End Sub

1 个答案:

答案 0 :(得分:0)

Nupur,

尝试此操作(已完成测试

替换代码

ActiveSheet.ChartObjects("Chart 7").Activate
ActiveSheet.ChartObjects("Chart 7").Activate
Selection.Cut
Sheets("Chart2").Select
ActiveChart.Paste

ActiveSheet.ChartObjects("Chart 7").Activate
ActiveChart.Location Where:=xlLocationAsObject, Name:="Chart2"

建议:我相信你录了一个宏? :)这两段代码做同样的事情:) Excel那种方式非常“谦虚”你只需要告诉它一次;)

ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate

和这个

ActiveSheet.ChartObjects("Chart 1").Activate

您可以安全地删除额外的行。

HTH

西特