2016-05-10 10 views
1

私はグラフを持ち、2点間に矢印を描きたいと思います。 2つのポイントは2つの異なるシリーズに由来しますが、同じx値を持ちます。VBA Extractシリーズのコレクション値

これを行うには、プロットポイントのy値とy軸の最小値と最大値を知る必要があると感じます。これから、私は矢印を描くことができるはずです。

私の質問はy値を取得する方法です。私は多くのチャートを繰り返しているので、テーブルから外したくないです。

私は、私のような何かをしようと思いましたでしょう

:私はエラーが最終であるように思わ:(仕事だろうが、私はちょうどランタイムとオートメーションエラーが出ると思っているだろう

Sub Tester() 
Dim sht As Worksheet 
Dim CurrentSheet As Worksheet 
Dim cht As ChartObject 
Dim PA_w, PA_h, PA_l, PA_t, min_x, min_y, max_x, max_y, _ 
x_node1, x_node2, y_node1, y_node2 As Double 
Dim Npts, i As Integer 
Dim s As Shape 

Application.ScreenUpdating = False 
Application.EnableEvents = False 

Set CurrentSheet = ActiveSheet 

For Each sht In ActiveWorkbook.Worksheets 
    For Each cht In sht.ChartObjects 
     cht.Activate 
     For Each s In cht.Chart.Shapes 
      If Not (s.Type = msoAutoShape) Then s.Delete 
     Next s 
     Set s1 = cht.Chart.SeriesCollection(3) 
     Set s2 = cht.Chart.SeriesCollection(4) 
     Npts = s1.Points.Count 
     PA_w = cht.Chart.PlotArea.InsideWidth 
     PA_h = cht.Chart.PlotArea.InsideHeight 
     PA_l = cht.Chart.PlotArea.InsideLeft 
     PA_t = cht.Chart.PlotArea.InsideTop 
     max_x = cht.Chart.Axes(1).MaximumScale 
     min_x = cht.Chart.Axes(1).MinimumScale 
     max_y = cht.Chart.Axes(2).MaximumScale 
     min_y = cht.Chart.Axes(2).MinimumScale 
     For i = 0 To 4 
      With cht.Chart.Shapes.AddLine(PA_l + i * PA_w/4, PA_t, PA_l + i * PA_w/4, 4 * PA_t + PA_h).Line 
      .ForeColor.RGB = RGB(0, 0, 0) 
     End With 
    Next i 
    With cht.Chart.Shapes 
     .AddLine(PA_l, PA_t, PA_l + PA_w, PA_t).Line.ForeColor.RGB = RGB(0, 0, 0) 
     .AddLine(PA_l, PA_t + PA_h, PA_l + PA_w, PA_t + PA_h).Line.ForeColor.RGB = RGB(0, 0, 0) 
     End With 
     For i = 1 To Npts 
      x_node1 = PA_l + (s1.XValues(i) - min_x) * PA_w/(max_x - min_x) 
      x_node2 = PA_l + (s2.XValues(i) - min_x) * PA_w/(max_x - min_x) 
      y_node1 = PA_t + (max_y - s1.Values(i)) * PA_h/(max_y - min_y) 
      y_node2 = PA_t + (max_y - s2.Values(i)) * PA_h/(max_y - min_y) 

      Set myShape = cht.Shapes.AddLine(x_node1, y_node1, x_node2, y_node2) 
      With myShape.Line 
       .EndArrowheadLength = msoArrowheadLong 
       .EndArrowheadWidth = msoArrowheadWidthMedium 
       .EndArrowheadStyle = msoArrowheadTriangle 
      End With 
     Next i 
    Next cht 
Next sht 

CurrentSheet.Activate 
Application.EnableEvents = True 

End Sub 

を、ループ用ブラケットに.Valuesと.XValues参照によって引き起こされる。

答えて

0

あなたが表示され、ジオメトリと遊ぶないようにフォーマットされたデータラベルまたはマーカーを使用することができます。datalabelsを使用してみました

Sub c() 

Dim c As Chart 
Dim s As Series 
Dim d As DataLabel 

Set c = ActiveSheet.ChartObjects(1).Chart 
Set s = c.SeriesCollection(2) 
Set d = s.DataLabels(1) 

Debug.Print d.Text, d.Top 


End Sub 
+0

しかし、それを読んで欲しくなく、エラーをスローアップします。 – Charlie

+0

何をしようとしましたか?あなたはhasdatalabelsをtrueに設定しなければなりません。 –