返回列表 上一主題 發帖

[發問] excel按日期作的工作表,如何將不同工作表中的日期欄位及良率欄位抓出作成折線圖

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 2012-4-5 22:21 | 顯示全部帖子
回復 1# showhi
第1次用VBA作圖表,請指正
結論:圖表物件太多,語法難記,大多用錄製的方式再作修改

1.自行新增"圖表"工作表

2.執行 Sub XX()
  1. Sub XX()
  2. With Sheets("圖表")
  3.   .[A1] = "日期"
  4.   .[B1] = "良率"
  5.   .[A2:B65536] = ""
  6.   For Each Sh In Sheets
  7.     If Sh.Name <> "圖表" Then
  8.       .[A65536].End(xlUp)(2) = Sh.Name
  9.       .[B65536].End(xlUp)(2) = 1 - Sh.[E26]
  10.     End If
  11.   Next
  12. End With
  13. Call ChartAdd
  14. End Sub
  15. Sub ChartAdd()
  16. With Sheets("圖表")
  17.   .ChartObjects.Delete                                 '刪除工作表內所有已存在之圖表物件
  18.   R = .[A65536].End(xlUp).Row
  19.   Set DataRng = .Range("A" & 1 & ":B" & R)             '指定資料範圍
  20.   Set ValueRng = .Range("B" & 2 & ":B" & R)            '指定數值範圍
  21.   Set XValueRng = .Range("A" & 2 & ":A" & R)           '指定類別座標軸範圍
  22.   Set Rng = Range("D1:Z23")                            '建立新圖表並指定位置及大小
  23.   Set mychart = .ChartObjects.Add(Rng(1).Left, Rng(1).Top, Rng.Width, Rng.Height)
  24.   With mychart.Chart
  25.     .ChartType = xlLine                                '指定圖表類型
  26.     .SetSourceData Source:=ValueRng, PlotBy:=xlColumns '指定數值範圍與數列資料取自欄或列
  27.     .ApplyDataLabels ShowValue:=True                   '設定顯示資料標籤
  28.     .HasTitle = True                                   '設定顯示標題與其內容
  29.     .ChartTitle.Text = "鍍膜"
  30.     With .ChartTitle.Font                              '設定標題之格式
  31.       .Size = 14
  32.       .ColorIndex = 3
  33.       .Name = "新細明體"
  34.     End With
  35.     With .ChartArea.Interior                           '設定圖表區之格式
  36.       .ColorIndex = 8
  37.       .PatternColorIndex = 1
  38.       .Pattern = xlSolid
  39.     End With
  40.     With .PlotArea.Interior                            '設定繪圖區之格式
  41.       .ColorIndex = 35
  42.       .PatternColorIndex = 1
  43.       .Pattern = xlSolid
  44.     End With
  45.     With .SeriesCollection(1).DataLabels               '設定數列1(良率)之格式
  46.       .Font.Size = 10
  47.       .Font.ColorIndex = 5
  48.       .NumberFormatLocal = "0.0%"
  49.       .Position = xlLabelPositionAbove
  50.     End With
  51.     With .SeriesCollection(1).Border
  52.       .ColorIndex = 3
  53.       .Weight = xlThick
  54.        .LineStyle = xlContinuous
  55.     End With
  56.     With .SeriesCollection(1)
  57.       .MarkerBackgroundColorIndex = 3
  58.       .MarkerForegroundColorIndex = 2
  59.       .MarkerStyle = xlCircle
  60.       .Smooth = True
  61.       .MarkerSize = 10
  62.       .Shadow = False
  63.     End With
  64.     With .Axes(xlCategory).TickLabels                  '設定類別座標軸之格式
  65.       .AutoScaleFont = False
  66.       .Font.Name = "新細明體"
  67.       .Font.Size = 12
  68.       .Alignment = xlCenter
  69.       .Offset = 50
  70.       .Orientation = xlVertical
  71.     End With
  72.     With .Axes(xlValue)
  73.       .TickLabels.AutoScaleFont = False
  74.       .MinimumScale = 0.9
  75.       .MaximumScale = 1
  76.     End With
  77.     With .Axes(xlValue).TickLabels
  78.       .Font.Name = "新細明體"
  79.       .Font.FontStyle = "標準"
  80.       .Font.Size = 12
  81.       .NumberFormatLocal = "0.00_ "
  82.     End With
  83.     .SeriesCollection(1).XValues = XValueRng
  84.   End With
  85. End With
  86. End Sub
複製代碼
3.結果

TOP

        靜思自在 : 世上有兩件事不能等：一、孝順 二、行善。
返回列表 上一主題