標題:
[發問]
excel按日期作的工作表,如何將不同工作表中的日期欄位及良率欄位抓出作成折線圖
[打印本頁]
作者:
showhi
時間:
2012-4-5 14:30
標題:
excel按日期作的工作表,如何將不同工作表中的日期欄位及良率欄位抓出作成折線圖
本帖最後由 showhi 於 2012-4-5 16:19 編輯
[attach]10309[/attach]excel按日期作的工作表,如何將不同工作表中的日期欄位及良率欄位抓出作成折線圖
作者:
GBKEE
時間:
2012-4-5 15:53
回復
1#
showhi
請附上 檔案資料 才知如何作
作者:
register313
時間:
2012-4-5 22:21
回復
1#
showhi
第1次用VBA作圖表,請指正
結論:圖表物件太多,語法難記,大多用錄製的方式再作修改
1.自行新增"圖表"工作表
[attach]10312[/attach]
2.執行 Sub XX()
Sub XX()
With Sheets("圖表")
.[A1] = "日期"
.[B1] = "良率"
.[A2:B65536] = ""
For Each Sh In Sheets
If Sh.Name <> "圖表" Then
.[A65536].End(xlUp)(2) = Sh.Name
.[B65536].End(xlUp)(2) = 1 - Sh.[E26]
End If
Next
End With
Call ChartAdd
End Sub
Sub ChartAdd()
With Sheets("圖表")
.ChartObjects.Delete '刪除工作表內所有已存在之圖表物件
R = .[A65536].End(xlUp).Row
Set DataRng = .Range("A" & 1 & ":B" & R) '指定資料範圍
Set ValueRng = .Range("B" & 2 & ":B" & R) '指定數值範圍
Set XValueRng = .Range("A" & 2 & ":A" & R) '指定類別座標軸範圍
Set Rng = Range("D1:Z23") '建立新圖表並指定位置及大小
Set mychart = .ChartObjects.Add(Rng(1).Left, Rng(1).Top, Rng.Width, Rng.Height)
With mychart.Chart
.ChartType = xlLine '指定圖表類型
.SetSourceData Source:=ValueRng, PlotBy:=xlColumns '指定數值範圍與數列資料取自欄或列
.ApplyDataLabels ShowValue:=True '設定顯示資料標籤
.HasTitle = True '設定顯示標題與其內容
.ChartTitle.Text = "鍍膜"
With .ChartTitle.Font '設定標題之格式
.Size = 14
.ColorIndex = 3
.Name = "新細明體"
End With
With .ChartArea.Interior '設定圖表區之格式
.ColorIndex = 8
.PatternColorIndex = 1
.Pattern = xlSolid
End With
With .PlotArea.Interior '設定繪圖區之格式
.ColorIndex = 35
.PatternColorIndex = 1
.Pattern = xlSolid
End With
With .SeriesCollection(1).DataLabels '設定數列1(良率)之格式
.Font.Size = 10
.Font.ColorIndex = 5
.NumberFormatLocal = "0.0%"
.Position = xlLabelPositionAbove
End With
With .SeriesCollection(1).Border
.ColorIndex = 3
.Weight = xlThick
.LineStyle = xlContinuous
End With
With .SeriesCollection(1)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 2
.MarkerStyle = xlCircle
.Smooth = True
.MarkerSize = 10
.Shadow = False
End With
With .Axes(xlCategory).TickLabels '設定類別座標軸之格式
.AutoScaleFont = False
.Font.Name = "新細明體"
.Font.Size = 12
.Alignment = xlCenter
.Offset = 50
.Orientation = xlVertical
End With
With .Axes(xlValue)
.TickLabels.AutoScaleFont = False
.MinimumScale = 0.9
.MaximumScale = 1
End With
With .Axes(xlValue).TickLabels
.Font.Name = "新細明體"
.Font.FontStyle = "標準"
.Font.Size = 12
.NumberFormatLocal = "0.00_ "
End With
.SeriesCollection(1).XValues = XValueRng
End With
End With
End Sub
複製代碼
3.結果
[attach]10313[/attach]
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)