Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


43385 / 76732 ←次へ | 前へ→

【38396】Re:ワークシート上のグラフの座標を知り...
発言  ichinose  - 06/6/1(木) 21:12 -

引用なし
パスワード
   今度は、Selectイベントを使用した例です。

散布図を例に取り上げました。

まず、新規ブックのSheet1のシートモジュールに
'==================================================================
Dim WithEvents cht As Chart
'===================================================================
Sub mk_sammple() 'サンプルデータとグラフの作成
  Dim mkcht As Chart
  With Me
    .Range("a1:b1").Value = Array("X", "Y")
    With .Range("a2:b31")
     .Formula = "=round(100*rand(),2)"
     .Value = .Value
     End With
    End With
  Set mkcht = ThisWorkbook.Charts.add
  With mkcht
    .ChartType = xlXYScatter
    .SetSourceData Source:=Me.Range("A1:B31"), PlotBy:=xlColumns
    .Location Where:=xlLocationAsObject, Name:=Me.Name
   End With
End Sub
'====================================================================
Sub set_obj() 'オブジェクトの設定
  Set cht = Me.ChartObjects(1).Chart
End Sub
Sub reset_obj() 'オブジェクトの設定解除
  Set cht = Nothing
End Sub
'====================================================================
Function edit_addr(add, podr As Long) As String
'Seriesのformulaプロパティの解析
  Dim idx As Long, jdx As Long
  Dim ans()
  Dim wk As Variant
  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
  jdx = 1
  For idx = LBound(wk) To UBound(wk)
   If TypeName(Application.Evaluate(wk(idx))) = "Range" Then
    ReDim Preserve ans(1 To jdx)
    ans(jdx) = wk(idx)
    jdx = jdx + 1
    End If
   Next
  If jdx > 1 Then
   edit_addr = Join(ans(), ",")
  Else
   edit_addr = ""
   End If
End Function
'======================================================================
Private Sub cht_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
'selectイベント
  Dim srs As Series
  Dim srsstr As Variant
  Dim addr As Variant
  If ElementID = xlSeries Then
    Set srs = cht.SeriesCollection(Arg1)
    srsstr = Split(edit_addr(srs.Formula, srs.PlotOrder), ",")
    xaddr = srsstr(UBound(srsstr) - 1)
    yaddr = srsstr(UBound(srsstr))
    If Arg2 = -1 Then
     Arg2 = 1
     srs.Points(Arg2).Select
     End If
    If Arg2 > 0 Then
     MsgBox "(x,y)=" & "(" & Application.Range(xaddr).Cells(Arg2).Value & "," & _
              Application.Range(yaddr).Cells(Arg2).Value & ")"
     End If
    End If
End Sub


1.まず、mk_sammpleを実行し、当該シートにサンプルデータとグラフを
  作成してください。

2.次にset_objを実行し、イベントの発生を可能にしてください。


3.ここから本番です。適当なプロットを選択してください。
 全てのポイントが選択された場合、自動的に最初のポイントを選択するように
 しています。このとき、最初のポイントのX,Yが表示されます。


4.続いて別のポイントを選択してください。選択されたポイントのX,Yが
  表示されます。

こちらは、正確な値が表示されます。


これを わいわいさんのおっしゃる「非直交5軸の線図」に
応用できますか?
6 hits

【38273】ワークシート上のグラフの座標を知りたい わいわい 06/5/30(火) 20:37 質問
【38299】Re:ワークシート上のグラフの座標を知りたい Kein 06/5/31(水) 3:12 回答
【38355】Re:ワークシート上のグラフの座標を知り... わいわい 06/5/31(水) 19:10 質問
【38360】Re:ワークシート上のグラフの座標を知り... Kein 06/5/31(水) 22:01 回答
【38371】Re:ワークシート上のグラフの座標を知り... ichinose 06/6/1(木) 8:25 発言
【38379】Re:ワークシート上のグラフの座標を知り... わいわい 06/6/1(木) 12:41 質問
【38381】Re:ワークシート上のグラフの座標を知り... Kein 06/6/1(木) 13:04 発言
【38395】Re:ワークシート上のグラフの座標を知り... ichinose 06/6/1(木) 20:38 発言
【38396】Re:ワークシート上のグラフの座標を知り... ichinose 06/6/1(木) 21:12 発言
【38412】Re:ワークシート上のグラフの座標を知り... わいわい 06/6/2(金) 9:33 お礼
【38413】Re:ワークシート上のグラフの座標を知り... ichinose 06/6/2(金) 10:01 発言
【38420】Re:ワークシート上のグラフの座標を知り... わいわい 06/6/2(金) 11:12 発言
【38435】Re:ワークシート上のグラフの座標を知り... ichinose 06/6/2(金) 19:11 発言
【38437】Re:ワークシート上のグラフの座標を知り... わいわい 06/6/2(金) 20:54 お礼
【38440】Re:ワークシート上のグラフの座標を知り... ichinose 06/6/2(金) 22:14 発言

43385 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free