| |
▼目指せマクロの達人 さん：
>EXCEL標準コマンドを使って、散布図を作成しました。
>全マーカーの代わりに同じ画像（簡単な線図）をおきたい。画像の角度がすべて同じなら、EXCELの基本機能でマーカーの代わりに、保存してある画像を指定をすれば出来ますが、ポイントごとに取り付け角度が異なります。 その角度はポイントごとにマーカーの座標とともに算出してあります。 EXCEL標準だけでは出来そうになく、VBAでこのようなことが出来るとありがたいのですが、よろしくご教示ください。
こんにちは〜
> マーカーの代わりに、保存してある画像を指定
ではないのですが、散布図の各要素から指定の方向に 矢印→ を描画する
ことなら、以前構造物のひずみ測定値のプロットでやったことがあります。
参考までにそれを今回用に多少アレンジしたものをアップします。
元データサンプル （A,B,C,D 列）
… このうち B,C列を使って 散布図は作成してあるものとしています。
番号 X座標 Y座標 測定角度
X1 -120 200 -35
X2 -120 240 -20
X3 -120 280 35
X4 -120 320 45
X5 -60 120 30
X6 -60 160 -10
X7 -60 200 -20
X8 -60 240 0
X9 -60 280 30
X10 -60 320 45
X11 -5 120 0
X12 -5 160 30
X13 -5 200 45
X14 -5 240 50
X15 -5 280 55
X16 -5 320 80
X17 -5 360 70
X18 50 120 45
X19 50 160 45
X20 50 200 30
X21 50 240 45
X22 50 280 35
X23 50 320 45
X24 110 160 55
X25 110 200 65
X26 110 240 80
x27 150 220 90
'--------------------------------------------- 標準モジュール
Option Explicit
Type WinPoint
x As Double
y As Double
End Type
Private FACTx As Double, FACT0x As Double
Private FACTy As Double, FACT0y As Double
'グラフのスケール(WindowScale)を ChartのPoint座標に
' 変換する係数をもとめる
Sub SetCoef(Cht As Chart)
Dim XMIN As Double, XMAX As Double
Dim YMIN As Double, YMAX As Double
Dim vxmi As Double, vxma As Double
Dim vYmi As Double, vYma As Double, t As Double
Dim Ax As Axis
With Cht
XMIN = .Axes(1).MinimumScale
XMAX = .Axes(1).MaximumScale
YMIN = .Axes(2).MinimumScale
YMAX = .Axes(2).MaximumScale
With .PlotArea
vxmi = .InsideLeft
vxma = vxmi + .InsideWidth
vYma = .InsideTop
vYmi = vYma + .InsideHeight
End With
If .Axes(2).ReversePlotOrder Then
t = vYma
vYma = vYmi
vYmi = t
End If
End With
FACTx = (vxma - vxmi) / (XMAX - XMIN)
FACT0x = vxmi - FACTx * XMIN
FACTy = (vYma - vYmi) / (YMAX - YMIN)
FACT0y = vYmi - FACTy * YMIN
End Sub
Function poxy(c, f) As WinPoint
poxy.x = c * FACTx + FACT0x
poxy.y = f * FACTy + FACT0y
End Function
Private Sub AngToVector(a, r As Double, x As Double, y As Double)
Dim ang As Double
ang = a * WorksheetFunction.Pi / 180
y = r * Sin(ang)
x = r * Cos(ang)
End Sub
Sub Example1()
Dim Cht As Chart '対象グラフ
Dim Ser As Series '系列1
Dim yRange As Range 'Y軸元データ範囲
Dim xData 'x データ
Dim yData 'y データ
Dim ang '角度データ(Y軸元データ範囲の右隣り)
Dim Vx1#, Vx2#
Dim Vy1#, Vy2#
Dim PoiXY(1 To 2) As WinPoint
Dim i&
Const RAD# = 33 '矢印の長さ
Set Cht = ActiveSheet.ChartObjects(1).Chart
Set Ser = Cht.SeriesCollection(1)
xData = Ser.XValues
yData = Ser.Values
Set yRange = Excel.Range(Split(Ser.Formula, ",")(2))
ang = yRange.Offset(, 1).Value
Cht.Lines.Delete 'すべての矢印を削除
'★グラフ軸Scaleをポイント座標に変換する係数を求める
SetCoef Cht
'矢印描画
For i = 1 To Ser.Points.Count
Vx1 = xData(i)
Vy1 = yData(i)
PoiXY(1) = poxy(Vx1, Vy1)
AngToVector ang(i, 1), RAD, Vx2, Vy2
PoiXY(2) = poxy(Vx1 + Vx2, Vy1 + Vy2)
With Cht.Shapes.AddLine(PoiXY(1).x, _
PoiXY(1).y, PoiXY(2).x, PoiXY(2).y).Line
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium
End With
Next
End Sub
一番下の Sub Example1() を実行してみてください。
X軸のScale単位で 長さ 33 の矢印が 各Pointから描かれたと思います。
ぼくのほうでは グラフのX軸スケールは -200〜 +200,
X軸スケールは 50〜 400 に設定してあります。各散布図のポイントは
このXY座標でプロットされているわけですが、この点から矢印を描画する
ときは グラフのプロットエリア(Inside Area) の左上端を (0,0)とする
Point座標に変換して長さパラメータを渡さないといけません。
そのための係数を計算しているのが SetCoef 呼び出し です。
グラフのスケールでの x, y座標は poxy()関数を使って グラフ内Point座標
に変換後矢印を描いています。
|
|
kanabun
- 12/5/28(月) 16:22 -
