最近开始学vba了,虽然很多都看不懂,从基础一点点开始,用到一点是一点吧~把现在写的几个小程序记录下来,以后需要的时候也不会忘记~我使用的是office2013,貌似不同的版本会报错?真是头疼的问题,我的excel每次打开都会把宏删除...到底怎么解决才好...
从画图开始:
Sub 绘制图表() '判断excel当前工作表是否存在图表,若有则删除,这是为了防止每次运行宏都产生新的图表,造成界面混乱 If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete End If '定义一个图表类 Dim chartobject As chartobject '定义一个图表 Dim BasketballDrillText_832x480_50 As Chart '在名称为420的工作表中添加一个宽200,高180的图表,该图表的位置是左起0,上起690 Set chartobject = Worksheets("420").ChartObjects.Add(0, 690, 200, 180) '把basketball设为chartobject类的表,即赋予属性 Set BasketballDrillText_832x480_50 = chartobject.Chart '定义图表类型,为带折线的散点图 BasketballDrillText_832x480_50.ChartType = xlXYScatterLines '选定初始数据范围,为420工作表的D3:E6 BasketballDrillText_832x480_50.SetSourceData Source:=Range("'420'!$D$3:$E$6") '对该图表的属性进行设置并添加数据源 With BasketballDrillText_832x480_50 .FullSeriesCollection(1).Name = "=""Anchor""" '第一组数据(即初始数据源)的名字为Anchor .SeriesCollection.NewSeries '增加新的数据源,命名为R-lambda,指定其x轴的数据源为J3:J6,y轴的数据源为K3:K6 .FullSeriesCollection(2).Name = "=""R-lambda""" .FullSeriesCollection(2).XValues = "='420'!$J$3:$J$6" .FullSeriesCollection(2).Values = "='420'!$K$3:$K$6" .SeriesCollection.NewSeries .FullSeriesCollection(3).Name = "=""Proposed""" .FullSeriesCollection(3).XValues = "='420'!$J$24:$J$27" .FullSeriesCollection(3).Values = "='420'!$K$24:$K$27" .HasTitle = True '设置图表名称,名字为BasketballDrillText_832x480_50,字体大小14,加粗 .ChartTitle.Text = "BasketballDrillText_832x480_50" .ChartTitle.Characters.Font.Size = 14 .ChartTitle.Characters.Font.Bold = True .Axes(xlCategory).HasTitle = True '设置X轴名称,名字为BasketballDrillText_832x480_50,字体大小9,加粗 .Axes(xlCategory).AxisTitle.Text = "Targetbitrate(Kbps)" .Axes(xlCategory).AxisTitle.Font.Size = 9 .Axes(xlCategory).AxisTitle.Font.Bold = True .Axes(xlValue).HasTitle = True '设置X轴名称,名字为BasketballDrillText_832x480_50,字体大小9,加粗 .Axes(xlValue).AxisTitle.Text = "PSNR_Y(dB)" .Axes(xlValue).AxisTitle.Font.Size = 9 .Axes(xlValue).AxisTitle.Font.Bold = True .SetElement (msoElementLegendRight) '设置图例,位置为绘图区右侧 .Legend.Select Selection.Left = 110 '选中图例,设置其位置大小 Selection.Top = 130 Selection.Width = 40 Selection.Height = 40 .PlotArea.Select '选中绘图区,设置其位置大小 Selection.Width = 180 Selection.Height = 140 Selection.Left = 10 Selection.Top = 30 .Axes(xlValue).MinimumScale = 30 '设置x、y轴数据范围,保证绘图后图像占图表大部分面积 ' .Axes(xlValue).MaximumScale = 20 End With BasketballDrillText_832x480_50.FullSeriesCollection(1).Select With Selection .MarkerStyle = 8 .MarkerSize = 5 End With Selection.MarkerStyle = 1 '设置第1数据源的标记线格式,可在图表设置时一并完成 BasketballDrillText_832x480_50.FullSeriesCollection(2).Select With Selection .MarkerStyle = 8 .MarkerSize = 5 End With Selection.MarkerStyle = 2 End Sub