- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# c_c_lai
版本不圖 不易偵錯 ,寫個範例你參考一下- Private Sub 製圖()
- Dim xR As Range, Xi As Integer, i As Integer, 圖色()
- 圖色 = Array(4, 6, 8, 10)
- ActiveSheet.ChartObjects.Delete '刪除全部圖表
- Set xR = Range("F1") '利用xR的位置 設下圖表的位置
- '加入新圖表 須指定 1右邊位置, 2高度位置, 3圖表的Width, 4圖表的Height
- With ChartObjects.Add(xR.Left, xR.Top, xR.Resize(, 10).Width, xR.Resize(10).Height).Chart
- .ChartType = 51 ' xlLineMarkers '折線圖 '圖表 式樣
- With ActiveSheet.Range("A11").CurrentRegion
- Set xR = Union(.Columns(1), .Columns(3), .Columns(5))
- '資料 範圍的 1,3,5 欄為圖表資料 :第1欄 為x軸的數值
- End With
- .SetSourceData Source:=xR, PlotBy:=xlColumns
- '圖表資料來源 : xR 資料式樣: 欄
-
- .HasTitle = True '顯示 圖表標題
- .ChartTitle.Characters.Text = ActiveSheet.Name 'HasTitle = False 會有錯誤
- .HasAxis(xlCategory, xlPrimary) = False '不顯示 X軸座標
-
- 'HasLegend 圖例
- .HasLegend = False ' 取消 顯示 圖例
- ' .Legend.Position = xlTop '顯示 圖例位置
- ' .Axes(xlCategory).TickLabels.NumberFormatLocal = "m/d;@" ' Axes(xlCategory) X座標軸
- ' ** 上二式 須 顯示圖例 -> .HasLegend = True
-
- '.SeriesCollection(1).AxisGroup = 2 '新增 Y座標軸 副座標軸
- ' .SeriesCollection(3)).Delete '刪除第3數列資料
- With .Axes(xlValue) 'y軸格線
- .HasMajorGridlines = 0 '取消 主格線
- .HasMinorGridlines = 0 '取消 副格線
- End With
- '以下一些程式碼 你可用錄製得知
- With .ChartArea '圖表的圖表區
- .Border.Weight = 1
- .Border.LineStyle = -1
- .Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=3, Degree:=0.231372549019608
- .Fill.Visible = True
- .Fill.ForeColor.SchemeColor = 圖色(0)
- End With
- With .PlotArea '圖表的 繪圖區
- .Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=1, _
- Degree:=0.231372549019608
- .Fill.Visible = True
- .Fill.ForeColor.SchemeColor = 圖色(0)
- With .Border
- .ColorIndex = 16
- .Weight = xlThin
- .LineStyle = xlContinuous
- End With
- End With
- For i = 1 To .SeriesCollection.Count
- With .SeriesCollection(i) '數列
- ' .XValues = "" '<-為x軸的數值 可在此取消
- With .Border
- .ColorIndex = 圖色(i)
- .Weight = xlMedium
- .LineStyle = xlContinuous
- End With
- '以下屬性 只適合 折線圖
- ' .MarkerBackgroundColorIndex = xlAutomatic
- '.MarkerForegroundColorIndex = xlAutomatic
- '.MarkerStyle = xlNone
- '.Smooth = False
- '.MarkerSize = 7
- '.Shadow = False
- End With
- Next
- End With
- End Sub
複製代碼 |
|