返回列表 上一主題 發帖

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

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

回復 10# stillfish00
非常感謝S大解惑,很抱歉之前忘記附檔了,這是第二個附件 Index_2.zip (91.7 KB)

1. 如 圖一,發現如果將vline指向座標2015/5/16,右方日期卻顯示2015/5/19,無法精準的對上座標。
   
    另外, Index_3.zip (92.06 KB) 這是用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
複製代碼
再麻煩大大了,非常感謝 : )

TOP

本帖最後由 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
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

回復 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
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 受人點水之恩,須當湧泉以報。
返回列表 上一主題