台灣最大程式設計社群網站
線上人數
693
 
會員總數:243856
討論主題:188345
歡迎您免費加入會員
討論區列表 >> office VBA / WinOS >> Excel 動態顯示圖表
[]  
[我要回覆]
1
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
Excel 動態顯示圖表
價值 : 120 QP  點閱數:160 回應數:1

樓主

新手學習
門外漢
0 19
268 19
發送站內信

***製作Excel 動態顯示圖表***

當CheckBox 被選取時, 該產品的趨線圖會呈現, CheckBox 沒有被選取者, 則不會出現.

問題: CheckBox 被選取時, 圖表未跟著變動, 請幫忙看哪裡有錯. 謝謝! (請參閱成品的圖片)

【在ThisWorkbook的程式碼如下】


Private Sub Workbook_Open()
'引用 Frame1物件
Set FrameCtl = Sheets("趨勢圖").OLEObjects("Frame1").Object.Controls
r = 3
'CheckBox控件依序填入名稱
For Each CheckObj In FrameCtl

r = r + 1 ' 抓取產品系列名稱
CheckObj.Caption = Sheets("趨勢圖").Cells(r, 1)
'儲存每個CheckBox控件對應的列
CheckObj.Tag = r
Next CheckObj
CheckBoxInitialize
End Sub







【在模組下的程式碼如下】

Public FrameCtl As Object
Public CheckObj As Object
Dim objCheckBox() As New clsCheckBox '引用clsCheckBox物件模組

Sub CheckBoxInitialize()
Dim ctlCount As Integer
'引用 Frame1物件
Set FrameCtl = Sheets("趨勢圖").OLEObjects("Frame1").Object.Controls
ctlCount = 0
For Each CheckObj In FrameCtl
ctlCount = ctlCount + 1
'重新配置動態陣列變數的儲存空間
ReDim Preserve objCheckBox(1 To ctlCount)
Set objCheckBox(ctlCount).CheckBoxGroup = CheckObj
Next CheckObj
End Sub

Sub NewSerie()
Dim r As Integer, k As Integer
Application.ScreenUpdating = False
With Sheets("趨勢圖")
.ChartObjects("圖表1").Activate
'刪除數列集合
For i = ActiveChart.SeriesCollection.Count To 1 Step -1
ActiveChart.SeriesCollection(i).Delete
Next
For Each CheckObj In FrameCtl
If CheckObj Then '如果Checkbox被選取
k = k + 1
r = Val(CheckObj.Tag)
ActiveChart.SeriesCollection.NewSeries '建立新數列
ActiveChart.SeriesCollection(k).XValues = _
.Range("B3:M3") '類別X標籤
ActiveChart.SeriesCollection(k).Values = _
.Range(.Cells(r, 4), .Cells(r, 23)) '數列數值
ActiveChart.SeriesCollection(k).Name = _
Sheets("趨勢圖").Cells(r, 3) '數列名稱
End If
Next CheckObj
End With
Application.ScreenUpdating = True
End Sub







【在物件類別模組的程式碼如下】

Public WithEvents CheckBoxGroup As MSForms.CheckBox

Private Sub CheckBoxGroup_Click()
NewSerie
End Sub




搜尋相關Tags的文章: [ 動態顯示圖表 ] ,
本篇文章發表於2018-10-18 18:09
別忘捐VP感謝幫助你的人 新手會員瞧一瞧
1樓
作者回應

新手學習
檢舉此回應
參閱成品的圖片

https://drive.google.com/drive/folders/1LrpGduuCBFNTV8ny8kWJ7tuxEgSHegnV?usp=sharing
本篇文章回覆於2018-10-18 18:33
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔--
   
1

回覆
如要回應,請先登入.