麻辣家族討論版版 - Powered by Discuz! Board

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

複製代碼

Sub setRowColumn(sDraw As String)
Dim oShape As Shape
Dim xRow, yCol, cHeight, cWidth, inLeft, inTop, inWidth As Integer
Dim totalRows As Single
Dim chartname As String
'totalRows = Sheets("統計圖表").Range("B" & Rows.Count).End(xlUp).Row ' 傳回 B 欄所使用儲存格之最後一格之列號
'如作用中物件不是工作表會有錯誤如是圖表等
totalRows = Sheets("統計圖表").Range("B" & Sheets("統計圖表").Rows.Count).End(xlUp).Row ' 傳回 B 欄所使用儲存格之最後一格之列號
Sheets(sDraw).Select
For Each oShape In ActiveSheet.Shapes
If oShape.Type = 3 Then
ActiveSheet.ChartObjects(oShape.Name).Activate ' 滑鼠點在 "圖表 #" 上 (例如：主力界入)。
'*************
'你上式程式碼使得作用中物件變為圖表後面的程式如有取的工作表的位址皆須加上 Sheets((工作表).[A1] 等...
ActiveChart.SetSourceData Source:=Range("統計圖表!$B$1:統計圖表!$B$" & totalRows & ", 統計圖表!$F$1:統計圖表!$F$" & totalRows & _
", 統計圖表!$I$1:統計圖表!$J$" & totalRows & ", 統計圖表!$S$1" & totalRows) ' 圖示會分別顯示出成交價、主力界入、以及散戶方向。
'ActiveChart.SeriesCollection.Add Source:=Range("統計圖表!$S$1"& totalRows)
'ActiveChart.SeriesCollection(4).Name = "=統計圖表!$S$1" '*** 位址要用R1C1 方式表示
'ActiveChart.SeriesCollection(4).Name = "=" & [統計圖表!$S$1].Address(, , xlR1C1, 1)
'ActiveChart.SeriesCollection(4).ChartType = xlColumnClustered ' 堆疊直條圖
xRow = 2
yCol = 1
cHeight = 488
cWidth = 450
inLeft = 30
inTop = 30
inWidth = 378
chartname = Trim(Replace(ActiveChart.Name, ActiveSheet.Name, ""))
'ActiveChart.ChartArea.Height = cHeight ' 將原本設定之高度調至適度位置
'ActiveChart.ChartArea.Width = cWidth
'ActiveSheet.Shapes(chartname).Left = Cells(xRow, yCol).Left ' 設定此圖表實際擺放的 X、Y 座標位置。
'ActiveSheet.Shapes(chartname).Top = Cells(xRow, yCol).Top
With ActiveChart.Parent
.Width = cWidth 'ChartArea.-改成父層 Parent
.Height = cHeight
.Left = ActiveSheet.Cells(xRow, yCol).Left
.Top = ActiveSheet.Cells(xRow, yCol).Top
With .Chart.PlotArea ' 實際繪圖區塊的範圍設定
Debug.Print .InsideLeft ' 傳回: 繪圖區塊範圍設定
Debug.Print .InsideTop 'Debug.Print: 印列在-> 在檢視指令->即時運算視窗
Debug.Print .InsideWidth
.Left = inLeft ' 設定: 繪圖區塊範圍
.Top = inTop
.Width = inWidth
End With
End With
End If
Next
End Sub

複製代碼

Sub DrawAll()
Call drawStatistics
Call drawOmegaCharts
End Sub
Sub drawStatistics()
drawCharts ("統計圖表")
End Sub
Sub drawOmegaCharts()
drawCharts ("Omega")
End Sub
Sub removeCharts(st As String)
Dim oShape As Shape
Dim str As String
str = ActiveSheet.Name
Sheets(st).Select
For Each oShape In ActiveSheet.Shapes
If oShape.Type = 3 Then
oShape.Delete
End If
Next
Sheets(str).Select
End Sub
Sub drawCharts(sta As String)
Dim str As String
str = ActiveSheet.Name
Sheets(sta).Select
Call removeCharts(sta)
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Call mainPowerForce(sta)
Cells(1, 1).Select
Sheets(str).Select
End Sub
Sub mainPowerForce(sDraw As String)
Dim totalRows As Single
Dim counter, xRow, yCol, cHeight, cWidth, inLeft, inTop, inWidth As Integer
Dim text As String
Dim chartname As String
' Dim rXY As Range
totalRows = Sheets("統計圖表").Range("B" & Rows.Count).End(xlUp).Row ' 傳回 B 欄所使用儲存格之最後一格之列號
Sheets(sDraw).Select
Cells(1, 1).Value = totalRows
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.ChartType = xlLine ' 折線圖
' 圖示會分別顯示出資料錄匯入之時間、成交價、主力界入、散戶方向、以及成交量。
' Set rXY = Union(Range("統計圖表!$B$1:統計圖表!$B$" & totalRows), Range("統計圖表!$F$1:統計圖表!$F$" & totalRows), Range("統計圖表!$I$1:統計圖表!$I$" & totalRows), Range("統計圖表!$J$1:統計圖表!$J$" & totalRows), Range("統計圖表!$V$1:統計圖表!$V$" & totalRows))
' .SetSourceData Source:=rXY
.SetSourceData Source:=Range("統計圖表!$B$1:統計圖表!$B$" & totalRows & ", 統計圖表!$F$1:統計圖表!$F$" & totalRows & _
", 統計圖表!$I$1:統計圖表!$J$" & totalRows & ", 統計圖表!$V$1:統計圖表!$V$" & totalRows) ' 圖示會分別顯示出成交價、主力界入、散戶方向、以及成交量。
' .SeriesCollection.Add Source:=Range("統計圖表!$V$2:統計圖表!$V$" & totalRows)
' .SeriesCollection(4).Name = "=統計圖表!$S$1"
.SeriesCollection(1).AxisGroup = 2
.SeriesCollection(2).ChartType = xlLine ' 折線圖
.SeriesCollection(4).ChartType = xlColumnClustered ' 堆疊直條圖
.Axes(xlCategory).CategoryType = xlCategoryScale
.Axes(xlCategory).TickLabels.NumberFormatLocal = "hh:mm"
.Axes(xlCategory).MajorTickMark = xlNone
.Axes(xlCategory).TickLabelPosition = xlLow
.Axes(xlValue, xlSecondary).TickLabels.NumberFormatLocal = "0_ " ' 代表物件的格式代碼。
.Axes(xlValue).TickLabels.NumberFormatLocal = "0_ " ' 代表物件的格式代碼。
End With
With ActiveChart.SeriesCollection(1).Format.Line ' 成交價
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0) ' 成交價指數顯示之顏色 --- 紅色
.Transparency = 0
End With
With ActiveChart.SeriesCollection(2).Format.Line ' 主力界入
.Visible = msoTrue
.ForeColor.RGB = RGB(32, 178, 170) ' 主力界入指數顯示之顏色 --- 海洋綠色
.Transparency = 0
End With
With ActiveChart.SeriesCollection(3).Format.Line ' 散戶方向
.Visible = msoTrue
.ForeColor.RGB = RGB(65, 105, 225) ' 散戶方向指數顯示之顏色 --- 天藍色
.Transparency = 0
End With
With ActiveChart.SeriesCollection(4).Format.Line ' 成交量
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 112, 219) ' 成交量指數顯示之顏色 --- 紫色
.Transparency = 0
End With
xRow = 2
yCol = 1
cHeight = 488
cWidth = 450
inLeft = 30
inTop = 30
inWidth = 378
text = "主力、散戶、與成交價、量"
chartname = Trim(Replace(ActiveChart.Name, ActiveSheet.Name, ""))
ActiveChart.ChartArea.Height = cHeight ' 將原本設定之高度調至適度位置
ActiveChart.ChartArea.Width = cWidth
ActiveSheet.Shapes(chartname).Left = Cells(xRow, yCol).Left ' 設定此圖表實際擺放的 X、Y 座標位置。
ActiveSheet.Shapes(chartname).Top = Cells(xRow, yCol).Top
With ActiveChart.PlotArea ' 實際繪圖區塊的範圍設定
.InsideLeft = inLeft
.InsideTop = inTop
.InsideWidth = inWidth
End With
ActiveChart.SetElement (msoElementChartTitleCenteredOverlay)
ActiveChart.ChartTitle.text = text
ActiveChart.ChartTitle.Format.TextFrame2.TextRange.Font.Size = 16
ActiveChart.Legend.Position = xlCorner ' 將圖表圖示從圖表最下方調整到圖表之右上角位置
' Set rXY = Nothing
End Sub
Sub resetRC()
Call setRowColumn("統計圖表")
Call setRowColumn("Omega")
End Sub
Sub setRowColumn(sDraw As String)
Dim oShape As Shape
Dim xRow, yCol, cHeight, cWidth, inLeft, inTop, inWidth As Integer
Dim totalRows As Single
Dim chartname As String
totalRows = Sheets("統計圖表").Range("B" & Rows.Count).End(xlUp).Row ' 傳回 B 欄所使用儲存格之最後一格之列號
Sheets(sDraw).Select
For Each oShape In ActiveSheet.Shapes
If oShape.Type = 3 Then
ActiveSheet.ChartObjects(oShape.Name).Activate ' 滑鼠點在 "圖表 #" 上 (例如：主力界入)。
' 圖示會分別顯示出資料錄匯入之時間、成交價、主力界入、散戶方向、以及成交量。
' Set rXY = Union(Range("統計圖表!$B$1:統計圖表!$B$" & totalRows), Range("統計圖表!$F$1:統計圖表!$F$" & totalRows), Range("統計圖表!$I$1:統計圖表!$I$" & totalRows), Range("統計圖表!$J$1:統計圖表!$J$" & totalRows), Range("統計圖表!$V$1:統計圖表!$V$" & totalRows))
' ActiveChart.SetSourceData Source:=rXY
ActiveChart.SetSourceData Source:=Range("統計圖表!$B$1:統計圖表!$B$" & totalRows & ", 統計圖表!$F$1:統計圖表!$F$" & totalRows & _
", 統計圖表!$I$1:統計圖表!$J$" & totalRows & ", 統計圖表!$V$1:統計圖表!$V$" & totalRows) ' 圖示會分別顯示出成交價、主力界入、散戶方向、以及成交量。
ActiveChart.SeriesCollection(4).ChartType = xlColumnClustered ' 堆疊直條圖
xRow = 2
yCol = 1
cHeight = 488
cWidth = 450
inLeft = 30
inTop = 30
inWidth = 378
chartname = Trim(Replace(ActiveChart.Name, ActiveSheet.Name, ""))
ActiveChart.ChartArea.Height = cHeight ' 將原本設定之高度調至適度位置
ActiveChart.ChartArea.Width = cWidth
ActiveSheet.Shapes(chartname).Left = Cells(xRow, yCol).Left ' 設定此圖表實際擺放的 X、Y 座標位置。
ActiveSheet.Shapes(chartname).Top = Cells(xRow, yCol).Top
With ActiveChart.PlotArea ' 實際繪圖區塊的範圍設定
.InsideLeft = inLeft
.InsideTop = inTop
.InsideWidth = inWidth
End With
End If
Next
' Set rXY = Nothing
End Sub

複製代碼