我在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
答案 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
西特