Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 10296|回复: 4

[已解决]如何用代码自动设置图表大小、位置、名称,在线等

[复制链接]
发表于 2014-3-27 14:30 | 显示全部楼层 |阅读模式
如附件所示,点击按钮后可自动生产图表,再次点击则删除旧图表并生成新图表(生成图表的宏为录制的),我想把每次生成的图表自动调整其大小、位置=单元格P6:AD37,图表名称自动生成为单元格“F2”的内容再加上“抽查记录”的字样,可是每次生成的图表名称都会变成“图表n+1”,本菜实在无计可施,求论坛里的老师们帮帮忙,谢谢。
最佳答案
2014-3-27 16:35
  1. Sub 随机抽样并排序()
  2.     Application.ScreenUpdating = False
  3.     Range("J11:K21").Value = Range("A11:B21").Value
  4.     iRow = Range("J:L").Cells(11, 1).End(xlDown).Row
  5.     Range("J:L").Cells(11, 1).Resize(iRow, 3).Clear    '清除旧数据

  6.     Dim shp As Object
  7.     For Each shp In ActiveSheet.ChartObjects
  8.         shp.Delete
  9.     Next
  10.     Dim dc As Object
  11.     Set dc = CreateObject("Scripting.Dictionary")
  12.     Randomize
  13.     Dim i As Long, n As Integer, m As Long, s As Integer
  14.     s = 1    'F、G列从第11行开始列数,如果从第一样这个数值应为-99
  15.     For i = 11 To 45000 Step 100    '样本和抽样间隔,从A、B列第11行开始取数,如果从第一行这个数值应为1 TO 45000
  16.         n = 0
  17.         s = s + 10
  18.         m = Int(Rnd * 99 + i)
  19.         dc.Add m, ""
  20.         Cells(s + n, "J") = Cells(m, "A")
  21.         Cells(s + n, "K") = Cells(m, "B")
  22.         Cells(s + n, "L") = Cells(m, "C")
  23.         For n = 1 To 4    '抽样量为50
  24.             Do While dc.exists(m)
  25.                 m = Int(Rnd * 99 + i)
  26.             Loop
  27.             dc.Add m, ""
  28.             Cells(s + n, "J") = Cells(m, "A")
  29.             Cells(s + n, "K") = Cells(m, "B")
  30.             Cells(s + n, "L") = Cells(m, "C")
  31.         Next
  32.     Next
  33.     Range("J10:L2300").Sort Key1:=Range("J10"), Order1:=xlAscending, Header:=xlGuess    '升序,降序则把xlAscending替换成xlDescending
  34.     With ActiveSheet.Shapes.AddChart

  35.         With .Chart
  36.             .ChartType = xlXYScatterLinesNoMarkers
  37.             .SetSourceData Source:=Range("数据!$L$10:$L$510,数据!$D$10:$I$510")
  38.             .SeriesCollection(1).XValues = "=数据!$J$10:$J$510"
  39.             .SeriesCollection(2).XValues = "=数据!$J$10:$J$510"
  40.             .SeriesCollection(3).XValues = "=数据!$J$10:$J$510"
  41.             .SeriesCollection(4).XValues = "=数据!$J$10:$J$510"
  42.             .SeriesCollection(5).XValues = "=数据!$J$10:$J$510"
  43.             .SeriesCollection(6).XValues = "=数据!$J$10:$J$510"
  44.             .SeriesCollection(6).ChartType = xlXYScatterLines
  45.             .SetElement (msoElementChartTitleAboveChart)
  46.             .ChartTitle.Text = Range("f2").Value & "抽查记录"
  47.         End With
  48.         .Name = Range("f2").Value & "抽查记录"
  49.         .Top = Range("p6").Top
  50.         .Left = Range("p6").Left
  51.         .Width = Range("p6:ad37").Width
  52.         .Height = Range("p6:ad37").Height
  53.     End With
  54.     Application.ScreenUpdating = True
  55.     MsgBox "图表生成完成"
  56. End Sub
复制代码

图表自动设置.rar

38.15 KB, 下载次数: 63

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-3-27 15:01 | 显示全部楼层
  1. Sub 随机抽样并排序()
  2.     Application.ScreenUpdating = False
  3.     Range("J11:K21").Value = Range("A11:B21").Value

  4.     iRow = Range("J:L").Cells(11, 1).End(xlDown).Row
  5.     Range("J:L").Cells(11, 1).Resize(iRow, 3).Clear    '清除旧数据

  6.     Dim shp As Object
  7.     For Each shp In ActiveSheet.ChartObjects
  8.         shp.Delete
  9.     Next

  10.     Dim dc As Object
  11.     Set dc = CreateObject("Scripting.Dictionary")
  12.     Randomize
  13.     Dim i As Long, n As Integer, m As Long, s As Integer
  14.     s = 1    'F、G列从第11行开始列数,如果从第一样这个数值应为-99
  15.     For i = 11 To 45000 Step 100    '样本和抽样间隔,从A、B列第11行开始取数,如果从第一行这个数值应为1 TO 45000
  16.         n = 0
  17.         s = s + 10
  18.         m = Int(Rnd * 99 + i)
  19.         dc.Add m, ""
  20.         Cells(s + n, "J") = Cells(m, "A")
  21.         Cells(s + n, "K") = Cells(m, "B")
  22.         Cells(s + n, "L") = Cells(m, "C")
  23.         For n = 1 To 4    '抽样量为50
  24.             Do While dc.exists(m)
  25.                 m = Int(Rnd * 99 + i)
  26.             Loop
  27.             dc.Add m, ""
  28.             Cells(s + n, "J") = Cells(m, "A")
  29.             Cells(s + n, "K") = Cells(m, "B")
  30.             Cells(s + n, "L") = Cells(m, "C")
  31.         Next
  32.     Next

  33.     Range("J10:L2300").Sort Key1:=Range("J10"), Order1:=xlAscending, Header:=xlGuess    '升序,降序则把xlAscending替换成xlDescending

  34.     With ActiveSheet.Shapes.AddChart
  35.         With .Chart
  36.             .ChartType = xlXYScatterLinesNoMarkers
  37.             .SetSourceData Source:=Range("数据!$L$10:$L$510,数据!$D$10:$I$510")
  38.             .SeriesCollection(1).XValues = "=数据!$J$10:$J$510"
  39.             .SeriesCollection(2).XValues = "=数据!$J$10:$J$510"
  40.             .SeriesCollection(3).XValues = "=数据!$J$10:$J$510"
  41.             .SeriesCollection(4).XValues = "=数据!$J$10:$J$510"
  42.             .SeriesCollection(5).XValues = "=数据!$J$10:$J$510"
  43.             .SeriesCollection(6).XValues = "=数据!$J$10:$J$510"
  44.             .SeriesCollection(6).ChartType = xlXYScatterLines

  45.         End With
  46.         .Name = Range("f2").Value & "抽查记录"
  47.         .Top = Range("p6").Top
  48.         .Left = Range("p6").Left
  49.         .Width = Range("p6:ad37").Width
  50.         .Height = Range("p6:ad37").Height
  51.     End With
  52.     Application.ScreenUpdating = True
  53.     MsgBox "图表生成完成"
  54. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-3-27 15:12 | 显示全部楼层
hwc2ycy 发表于 2014-3-27 15:01

感谢版主的热情帮助,可能我没描述清楚,其实我希望图表的“标题”(不是名称)是单元格“F2”的内容再加上“抽查记录”的字样.能帮我再改改么?谢谢!
回复

使用道具 举报

发表于 2014-3-27 16:35 | 显示全部楼层    本楼为最佳答案   
  1. Sub 随机抽样并排序()
  2.     Application.ScreenUpdating = False
  3.     Range("J11:K21").Value = Range("A11:B21").Value
  4.     iRow = Range("J:L").Cells(11, 1).End(xlDown).Row
  5.     Range("J:L").Cells(11, 1).Resize(iRow, 3).Clear    '清除旧数据

  6.     Dim shp As Object
  7.     For Each shp In ActiveSheet.ChartObjects
  8.         shp.Delete
  9.     Next
  10.     Dim dc As Object
  11.     Set dc = CreateObject("Scripting.Dictionary")
  12.     Randomize
  13.     Dim i As Long, n As Integer, m As Long, s As Integer
  14.     s = 1    'F、G列从第11行开始列数,如果从第一样这个数值应为-99
  15.     For i = 11 To 45000 Step 100    '样本和抽样间隔,从A、B列第11行开始取数,如果从第一行这个数值应为1 TO 45000
  16.         n = 0
  17.         s = s + 10
  18.         m = Int(Rnd * 99 + i)
  19.         dc.Add m, ""
  20.         Cells(s + n, "J") = Cells(m, "A")
  21.         Cells(s + n, "K") = Cells(m, "B")
  22.         Cells(s + n, "L") = Cells(m, "C")
  23.         For n = 1 To 4    '抽样量为50
  24.             Do While dc.exists(m)
  25.                 m = Int(Rnd * 99 + i)
  26.             Loop
  27.             dc.Add m, ""
  28.             Cells(s + n, "J") = Cells(m, "A")
  29.             Cells(s + n, "K") = Cells(m, "B")
  30.             Cells(s + n, "L") = Cells(m, "C")
  31.         Next
  32.     Next
  33.     Range("J10:L2300").Sort Key1:=Range("J10"), Order1:=xlAscending, Header:=xlGuess    '升序,降序则把xlAscending替换成xlDescending
  34.     With ActiveSheet.Shapes.AddChart

  35.         With .Chart
  36.             .ChartType = xlXYScatterLinesNoMarkers
  37.             .SetSourceData Source:=Range("数据!$L$10:$L$510,数据!$D$10:$I$510")
  38.             .SeriesCollection(1).XValues = "=数据!$J$10:$J$510"
  39.             .SeriesCollection(2).XValues = "=数据!$J$10:$J$510"
  40.             .SeriesCollection(3).XValues = "=数据!$J$10:$J$510"
  41.             .SeriesCollection(4).XValues = "=数据!$J$10:$J$510"
  42.             .SeriesCollection(5).XValues = "=数据!$J$10:$J$510"
  43.             .SeriesCollection(6).XValues = "=数据!$J$10:$J$510"
  44.             .SeriesCollection(6).ChartType = xlXYScatterLines
  45.             .SetElement (msoElementChartTitleAboveChart)
  46.             .ChartTitle.Text = Range("f2").Value & "抽查记录"
  47.         End With
  48.         .Name = Range("f2").Value & "抽查记录"
  49.         .Top = Range("p6").Top
  50.         .Left = Range("p6").Left
  51.         .Width = Range("p6:ad37").Width
  52.         .Height = Range("p6:ad37").Height
  53.     End With
  54.     Application.ScreenUpdating = True
  55.     MsgBox "图表生成完成"
  56. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-3-27 18:22 | 显示全部楼层
hwc2ycy 发表于 2014-3-27 16:35

非常感谢,这个论坛对于我们菜鸟来说真心帮助不少啊!!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 18:44 , Processed in 0.292329 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表