[發問] 類似移動指引線的效果

栗栗子

各位大大好：

小妹在使用EXCEL分析資料時出現有關圖表中資料標籤的困難，首先，若我們僅有一個變數要分析的話就沒有此問題，因為當電腦游標指向需要查詢處便會自動顯示資料標籤，如下圖一

下載 (59.26 KB)
圖一

2015-12-11 12:01

栗栗子

各位大大好：

抱歉上面沒打完就按到送出了，超過三分鐘不能編輯><，下面是完整的內容~

小妹在使用EXCEL分析資料時出現有關圖表中資料標籤的困難，首先，若我們僅有一個變數要分析的話就沒有此問題，
因為當電腦游標指向需要查詢處便會自動顯示資料標籤，如下圖一

下載 (59.26 KB)

2015-12-11 12:21

但是當變數資料一多的時候，EXCEL僅能顯示一個變數的資料標籤，使得在趨勢分析上相當困難，如下圖二

下載 (92.47 KB)

2015-12-11 12:04

EXCEL也有顯示所有資料標籤的功能，但因為資料繁多使得圖表完全沒有可讀性，見圖三。

下載 (180.28 KB)

2015-12-11 12:05

小妹嘗試很久也沒有僅顯示一筆資料標籤的功能，不知各位大大是否在程式中有方法可以讓EXCEL有類似下圖四看盤軟體中類似移動查價線的效果，

下載 (90.97 KB)

2015-12-11 12:08

下圖五是小妹希望最後的功能以及附件，麻煩有勞各位大大，我很需要這個功能~~~

下載 (99.8 KB)

2015-12-11 12:10

Index.zip (77.95 KB)

下載次數: 13

2015-12-11 12:15

c_c_lai

回復 2# 栗栗子
參考以下資訊是否就是妳所構思的模式？
K 線股票圖如何能與主力、散戶、及成交量線共存？

jackyq

你自己可以去寫一個

下載 (170.95 KB)

2015-12-12 14:27

stillfish00

回復 2# 栗栗子
新增物件類別模組，命名 EventClassModule

1. Private WithEvents myChartClass As Chart
   
2. Private myVLine As Object
   
3. Private myTarget As Range
   
4. 
   
5. Public Sub InitializeChart(objChart As Object, rngTarget As Range)
   
6.     Set myChartClass = objChart
   
7.     Set myTarget = rngTarget
   
8.    
   
9.     On Error Resume Next
   
10.     Set myVLine = myChartClass.Shapes("vline")
    
11.     On Error GoTo 0
    
12.    
    
13.     If myVLine Is Nothing Then
    
14.         With myChartClass.PlotArea
    
15.             Set myVLine = myChartClass.Shapes.AddLine(.InsideLeft, .InsideTop, .InsideLeft, .InsideTop + .InsideHeight)
    
16.             myVLine.Name = "vline"
    
17.         End With
    
18.     End If
    
19. End Sub
    
20. 
    
21. Private Sub myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    
22.     Dim pt_x As Double, interval As Double, indx As Long
    
23.     Dim arValues
    
24.    
    
25.     pt_x = 75 * x / ActiveWindow.Zoom
    
26.     interval = myChartClass.PlotArea.InsideWidth / UBound(myChartClass.SeriesCollection(1).XValues)
    
27.     indx = Application.RoundUp((pt_x - myChartClass.PlotArea.InsideLeft) / interval, 0)
    
28.     indx = Application.Min(Application.Max(1, indx), UBound(myChartClass.SeriesCollection(1).XValues))
    
29.         
    
30.     With myChartClass.SeriesCollection
    
31.         If .Count = 0 Then Exit Sub
    
32.         For i = 1 To .Count
    
33.             With .Item(i)
    
34.                 .ApplyDataLabels Type:=xlDataLabelsShowNone
    
35.                 .Points(indx).ApplyDataLabels Type:=xlDataLabelsShowValue
    
36.                 .Points(indx).DataLabel.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
    
37.                 arValues = .Values
    
38.                 If i <= myTarget.Cells.Count Then myTarget.Cells(i + 1).Value = arValues(indx)
    
39.             End With
    
40.         Next
    
41.         arValues = .Item(1).XValues
    
42.         myTarget.Cells(1).Value = arValues(indx)
    
43.     End With
    
44.    
    
45.     With myChartClass
    
46.         If .Axes(xlCategory).AxisBetweenCategories Then
    
47.             myVLine.Left = .PlotArea.InsideLeft + (indx - 0.5) * interval
    
48.         Else
    
49.             myVLine.Left = .PlotArea.InsideLeft + (indx - 1) * interval
    
50.         End If
    
51.     End With
    
52. End Sub

複製代碼

一般模組：

1. Dim myChart As EventClassModule
   
2. 
   
3. Sub TriggerChartVLine()
   
4.     With Sheets(1)
   
5.         Set myChart = New EventClassModule
   
6.         myChart.InitializeChart .ChartObjects(1).Chart, .Range("U15:U18")
   
7.     End With
   
8. End Sub
   
9. 
   
10. Sub Auto_Open()
    
11.     TriggerChartVLine
    
12. End Sub

複製代碼

Index.zip (93.23 KB)

下載次數: 30

2015-12-15 12:14

栗栗子

回復 3# c_c_lai

C大您好：

因為小妹才剛加入沒有多久，積分不夠下載附件，

請問有其他方法可以下載嗎＞＜，還是只能等積分到50之後才能拜讀了:'( :'(

栗栗子

回復 5# stillfish00

S大您好：
非常感謝您，問題解決了＞＜，但還不太熟悉物件模組的使用方法，小妹會好好研究的～～～

c_c_lai

回復 6# 栗栗子
加油！多多參與討論自會有所收穫的。
另外在 stillfish00 大大 模組 (Module1)
裡再加上  .ChartObjects(1).Activate，
如此滑鼠只要在圖表上滑動，指引線
即刻有類似移動的效果，亦即一進入
本表單立即啟動指引線有類似移動的效果

1. Sub TriggerChartVLine()
   
2.     With Sheets(1)
   
3.         Set myChart = New EventClassModule
   
4.         myChart.InitializeChart .ChartObjects(1).Chart, .Range("U15:U18")
   
5.         .ChartObjects(1).Activate    '  一進入本表單指引線即刻有類似移動的效果
   
6.     End With
   
7. End Sub

複製代碼

栗栗子

回復 5# stillfish00
S大您好：
在研究的過程中小妹又遇到了以下問題QQ，請大大們幫忙解惑 ><

1.就是說折線圖中的XValues值是連續的，也就是XValues從2012/10/16~2015/9/16是不間斷的值，但因為股市會休市的關係，交易日期是不連續的，導致XValues大於總筆數720筆。
   因此indx指向日期會產生偏差。目前小妹的解決方式是將用A欄日期放到陣列(XValueOutZero)中，再用indx指向此陣列(XValueOutZero)。下面是小妹加的程式碼

1. Private Sub myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
   
2.     Dim pt_x As Double, interval As Double, indx As Long
   
3.     Dim arValues, XValueOutZero
   
4.    
   
5.     XValueOutZero = Range("A2:A721").Value
   
6.     pt_x = 75 * x / ActiveWindow.Zoom
   
7.     interval = myChartClass.PlotArea.InsideWidth / UBound(myChartClass.SeriesCollection(1).XValues) '傳回此陣列之維度之最高可用註標(索引)
   
8.     indx = Application.RoundUp((pt_x - myChartClass.PlotArea.InsideLeft) / interval, 0)
   
9.     indx = Application.Min(Application.Max(1, indx), UBound(myChartClass.SeriesCollection(1).XValues))
   
10.    
    
11.     With myChartClass.SeriesCollection
    
12.         If .Count = 0 Then Exit Sub
    
13.         For i = 1 To .Count
    
14.             With .Item(i)
    
15.                 .ApplyDataLabels Type:=xlDataLabelsShowNone
    
16.                 .Points(indx).ApplyDataLabels Type:=xlDataLabelsShowValue
    
17.                 .Points(indx).DataLabel.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
    
18.                 arValues = .Values
    
19.                 If i <= myTarget.Cells.Count Then myTarget.Cells(i + 1).Value = arValues(indx)
    
20.             End With
    
21.         Next
    
22.         'arValues = .Item(1).XValues
    
23.         myTarget.Cells(1).Value = XValueOutZero(indx, 1)
    
24.     End With
    
25.     myVLine.Line.ForeColor.RGB = RGB(0, 0, 0)
    
26.     myVLine.Line.Weight = 0.25
    
27.     With myChartClass
    
28.         If .Axes(xlCategory).AxisBetweenCategories Then
    
29.             myVLine.Left = .PlotArea.InsideLeft + (indx - 0.5) * interval
    
30.         Else
    
31.             myVLine.Left = .PlotArea.InsideLeft + (indx - 1) * interval
    
32.         End If
    
33.     End With
    
34. End Sub

複製代碼

但是這樣子又發現vline無法精準的指向正確的日期，如圖1，vline指向的日期應該是2015/5/16，但是卻顯示2015/5/19的日期:'(

2. 另外，myChartClass_MouseMove是在進入滑鼠在圖表中移動這個事件發生時所執行的程式，它需要有4個傳入值

1. myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)

複製代碼

，但在滑鼠在圖表移動時並沒有執行其它程式碼，那麼 myChartClass_MouseMove 是怎麼得到這些傳入值的呢，這些傳入值又是什麼 ?

3. 最後想請問大大下面這段程式的用意是什麼 >< ?

1.     With myChartClass
   
2.         If .Axes(xlCategory).AxisBetweenCategories Then
   
3.             myVLine.Left = .PlotArea.InsideLeft + (indx - 0.5) * interval
   
4.         Else
   
5.             myVLine.Left = .PlotArea.InsideLeft + (indx - 1) * interval
   
6.         End If
   
7.     End With
   
8. End Sub

複製代碼

以上問題小妹百思不得其解，求助大大們，問題多又笨也請各位大大海涵:Q :Q

stillfish00

回復 9# 栗栗子
1. 能附檔案看看比較好，或是試試改成這樣

1. Private Sub myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
   
2.     Dim pt_x As Double, interval As Double, indx As Long
   
3.     Dim arValues, targetX
   
4.     Dim isAxisBetween As Boolean, dataCount As Long, diffX, xOffset
   
5.    
   
6.     pt_x = 75 * x / ActiveWindow.Zoom
   
7.    
   
8.     With myChartClass
   
9.         If .SeriesCollection.Count = 0 Then Exit Sub
   
10.         isAxisBetween = .Axes(xlCategory).AxisBetweenCategories '座標軸位置 刻度間:True 刻度上:False
    
11.         arValues = .SeriesCollection(1).XValues '日期資料
    
12.         dataCount = UBound(arValues)    '資料數目
    
13.         With .Axes(xlCategory)
    
14.             diffX = .MaximumScale - .MinimumScale
    
15.             xOffset = IIf(isAxisBetween, 0.5 * myChartClass.PlotArea.InsideWidth / (diffX + 1), 0)
    
16.             If pt_x < myChartClass.PlotArea.InsideLeft + xOffset Then
    
17.                 indx = 1
    
18.             Else
    
19.                 targetX = .MinimumScale + diffX * (pt_x - myChartClass.PlotArea.InsideLeft - xOffset) / (myChartClass.PlotArea.InsideWidth - 2 * xOffset)
    
20.                 indx = Application.Match(targetX, arValues, 1)
    
21.                 If indx < UBound(arValues) Then
    
22.                     If Abs(targetX - arValues(indx + 1)) < Abs(targetX - arValues(indx)) Then indx = indx + 1   '修正最近資料點
    
23.                 End If
    
24.             End If
    
25.             
    
26.         End With
    
27.         myVLine.Left = .PlotArea.InsideLeft + xOffset + (.PlotArea.InsideWidth - 2 * xOffset) * (arValues(indx) - arValues(1)) / CDbl(diffX)
    
28.         myTarget.Cells(1).Value = arValues(indx)
    
29.         For i = 1 To .SeriesCollection.Count
    
30.             With .SeriesCollection(i)
    
31.                 .ApplyDataLabels Type:=xlDataLabelsShowNone
    
32.                 .Points(indx).ApplyDataLabels Type:=xlDataLabelsShowValue
    
33.                 .Points(indx).DataLabel.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
    
34.                 arValues = .Values
    
35.                 If i < myTarget.Cells.Count Then myTarget.Cells(i + 1).Value = arValues(indx)
    
36.             End With
    
37.         Next
    
38.     End With
    
39. End Sub

複製代碼

2. MouseMove 是 Chart(圖表) 內建的事件，當滑鼠指標在圖表上的位置改變時會自動觸發此事件。
    事件的參數會自己傳入，你只要知道傳入的東西到底是代表什麼。
    各參數說明可以自己F1查 MouseMove得知。
    Button  : 事件發生時，滑鼠按鍵狀態
    Shift : 事件發生時 SHIFT、CTRL 和 ALT 鍵的狀態
    x : 滑鼠指標在圖表物件工作區座標中的 X 座標。
    y : 滑鼠指標在圖表物件工作區座標中的 Y 座標。
3. 是因為座標軸格式中，座標軸位置分為刻度上和刻度與刻度間相距兩種，會影響資料點位置。