Board logo

標題: [發問] 類似移動指引線的效果 [打印本頁]
作者: 栗栗子    時間: 2015-12-11 12:02     標題: 類似移動指引線的效果

各位大大好：

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

[attach]22793[/attach]
作者: 栗栗子    時間: 2015-12-11 12:23

各位大大好：

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

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

[attach]22799[/attach]

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

[attach]22794[/attach]

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

[attach]22795[/attach]

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

[attach]22796[/attach]

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

[attach]22797[/attach]

[attach]22798[/attach]
作者: c_c_lai    時間: 2015-12-12 11:42

回復 2# 栗栗子
參考以下資訊是否就是妳所構思的模式？
K 線股票圖如何能與主力、散戶、及成交量線共存？
作者: jackyq    時間: 2015-12-12 14:28

你自己可以去寫一個

[attach]22807[/attach]
作者: stillfish00    時間: 2015-12-15 12:14

回復 2# 栗栗子
新增物件類別模組，命名 EventClassModule
  1. Private WithEvents myChartClass As Chart
  2. Private myVLine As Object
  3. Private myTarget As Range

  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

  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

  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

  10. Sub Auto_Open()
  11.     TriggerChartVLine
  12. End Sub
複製代碼
[attach]22842[/attach]
作者: 栗栗子    時間: 2015-12-17 14:50

回復 3# c_c_lai

C大您好：

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

請問有其他方法可以下載嗎＞＜，還是只能等積分到50之後才能拜讀了:'( :'(
作者: 栗栗子    時間: 2015-12-17 15:41

回復 5# stillfish00

S大您好：
非常感謝您，問題解決了＞＜，但還不太熟悉物件模組的使用方法，小妹會好好研究的∼∼∼
作者: c_c_lai    時間: 2015-12-17 18:50

本帖最後由 c_c_lai 於 2015-12-17 18:53 編輯

回復 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
複製代碼
作者: 栗栗子    時間: 2015-12-22 09:35

回復 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    時間: 2015-12-23 17:30

回復 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. 是因為座標軸格式中，座標軸位置分為刻度上和刻度與刻度間相距兩種，會影響資料點位置。
作者: 栗栗子    時間: 2015-12-24 13:10

本帖最後由 栗栗子 於 2015-12-24 13:12 編輯

回復 10# stillfish00
非常感謝S大解惑，很抱歉之前忘記附檔了，這是第二個附件[attach]22963[/attach]

1. 如 圖一，發現如果將vline指向座標2015/5/16，右方日期卻顯示2015/5/19，無法精準的對上座標。
    [attach]22960[/attach]
    另外，[attach]22964[/attach]這是用S大提供的修改過後的程式碼的附件，會出現型態不符合的error＞＜

2.原來 Chart.MouseMove 事件會自動傳入值，感謝S大受教了 ~
    另外查了一些物件類別模組的使用方法，https://msdn.microsoft.com/zh-tw/library/office/ff192938.aspx
    還是不太理解，可以請大大舉一個簡單的例子說明一下嗎 > <

3.還有一個額外的問題，下面這一段程式碼，為什麼在計算 x 的 pt 時要再乘上 75 呢 ?  這個數字是怎麼來的 ?
  1. pt_x = 75 * x / ActiveWindow.Zoom
複製代碼
再麻煩大大了，非常感謝 : )
作者: stillfish00    時間: 2015-12-24 15:07

本帖最後由 stillfish00 於 2015-12-24 15:11 編輯

回復 11# 栗栗子
1.  indx = Application.Match(targetX, arValue, 1)
     這句 arValue 改成 arValues , 筆誤。

3. 我也是上網查的，你在查 Chart 的 InsideLeft 或 InsideWidth 這些屬性時都會告訴你它是以"點"為單位，一個點定義是1/72英吋 (也有人定義為1/72.27英吋)。

而傳入參數的  x , y 單位是 pixel(像素)；根據windows內顯示器 DPI(dot per inch) 設定可決定每英吋多少像素，一般預設為 normal size 100% (=96 DPI)，表示每英吋 96 像素。

所以要把 x 像素轉成點要乘以 72/96=0.75
還要考慮 zoom , 所以變成  0.75*x/(ActiveWindow.zoom/100) = 75*x/ActiveWindow.zoom
作者: stillfish00    時間: 2015-12-25 09:59

回復 11# 栗栗子
修改 myVLine.Left 從該資料點的 left 屬性取得，如下
你說的無法精準的對上座標，那是你資料太密集，圖表本身日期座標軸就會這樣(每個月天數是不同的，它卻同間隔)
  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, diffX
  4.     Dim isAxisBetween As Boolean, 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.         diffX = .Axes(xlCategory).MaximumScale - .Axes(xlCategory).MinimumScale
  13.         xOffset = IIf(isAxisBetween, 0.5 * .PlotArea.InsideWidth / (diffX + 1), 0)
  14.         
  15.         If pt_x < .PlotArea.InsideLeft + xOffset Then
  16.             indx = 1
  17.         Else
  18.             targetX = .Axes(xlCategory).MinimumScale + diffX * (pt_x - .PlotArea.InsideLeft - xOffset) / (.PlotArea.InsideWidth - 2 * xOffset)
  19.             indx = Application.Match(targetX, arValues, 1)
  20.             If indx < UBound(arValues) Then If Abs(targetX - arValues(indx + 1)) < Abs(targetX - arValues(indx)) Then indx = indx + 1  '修正最近資料點
  21.         End If
  22.             
  23.         myVLine.Left = .SeriesCollection(1).Points(indx).Left
  24.         myTarget.Cells(1).Value = arValues(indx)
  25.         For i = 1 To .SeriesCollection.Count
  26.             With .SeriesCollection(i)
  27.                 .ApplyDataLabels Type:=xlDataLabelsShowNone
  28.                 .Points(indx).ApplyDataLabels Type:=xlDataLabelsShowValue
  29.                 .Points(indx).DataLabel.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
  30.                 arValues = .Values
  31.                 If i < myTarget.Cells.Count Then myTarget.Cells(i + 1).Value = arValues(indx)
  32.             End With
  33.         Next
  34.     End With
  35. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)