#contents *Excel 関連情報 **サンプルコード ***オートシェイプの使い方 -オートシェイプを使って線を描画するサンプル(その2) ' オートシェイプを使って線を描画するサンプル(その2) ' <テストデータ> ' 番号、X座標、Y座標、経路開始、経路終了 ' 0, 5, 49, 0, 3 ' 1, 2, 5, 0, 4 ' 2, 12, 8, 1, 2 ' 3, 45, 45, 2, 4 ' 4, 4, 21, 2, 9 ' 5, 32, 13, 9, 13 ' 6, 34, 30, 11, 13 ' 7, 30, 31, 1, 7 ' 8, 33, 24, 5, 7 ' 9, 22, 10, 5, 12 ' 10, 20, 5 ' 11, 8, 40 ' 12, 11, 21 ' 13, 37, 43 Option Explicit Const g_nCount = 14 ' データ件数 Const g_nScale = 5 ' 倍率 Const g_nPair = 10 ' 経路数 Const g_nX_Origin = 10 ' X軸の原点の位置 Const g_nY_Origin = 10 ' Y軸の原点の位置 Const g_nX_Step = 10 ' X軸の目盛りの単位 Const g_nY_Step = 10 ' Y軸の目盛りの単位 Const g_nX_MAX = 100 ' X軸の最大値 Const g_nY_MAX = 100 ' Y軸の最大値 ' メイン Sub Main() DrawGrid ' 方眼用紙の作成 DrawDot ' 点の描画 DrawLine ' 経路の描画 ' オートシェイプのグループ化 ActiveSheet.Shapes.SelectAll Selection.ShapeRange.Group.Select End Sub ' 方眼用紙の作成 Sub DrawGrid() Dim x Dim y Dim x_st ' 線の開始位置(X軸) Dim y_st ' 線の開始位置(Y軸) Dim x_ed ' 線の終了位置(X軸) Dim y_ed ' 線の終了位置(Y軸) Dim line ' オートシェイプ:線 Dim text ' オートシェイプ:テキストボックス ' 方眼用紙の背景の描画 x = g_nX_Origin * g_nScale y = 0 ActiveSheet.Shapes.AddShape msoShapeRectangle, x, y, g_nX_MAX * g_nScale, g_nY_MAX * g_nScale For x = 0 To g_nX_MAX Step g_nX_Step With ActiveSheet x_st = (x + g_nX_Origin) * g_nScale y_st = (g_nY_MAX) * g_nScale x_ed = (x_st) y_ed = (0) ' 線を表示(X座標、Y座標、X座標2、Y座標2) Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed) ' 番号を表示(X座標、Y座標、幅、高さ) Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x_st - 15, y_st + 10, 30, 15) text.Select Selection.Characters.text = CStr(x) Selection.HorizontalAlignment = xlCenter ' 中央揃え text.Fill.Visible = msoFalse ' 非表示に text.line.Visible = msoFalse ' 非表示に End With Next For y = 0 To g_nY_MAX Step g_nY_Step With ActiveSheet x_st = (g_nX_Origin) * g_nScale y_st = (g_nY_MAX - y) * g_nScale x_ed = (g_nX_Origin + g_nX_MAX) * g_nScale y_ed = y_st ' 線を表示(X座標、Y座標、X座標2、Y座標2) Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed) ' 番号を表示(X座標、Y座標、幅、高さ) Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x_st - 35, y_st - 5, 30, 15) text.Select Selection.Characters.text = CStr(y) Selection.HorizontalAlignment = xlRight ' 右寄せ text.Fill.Visible = msoFalse ' 非表示に text.line.Visible = msoFalse ' 非表示に End With Next End Sub ' 点の描画 Sub DrawDot() Dim n ' データの番号 Dim x ' 線の開始位置(X軸) Dim y ' 線の開始位置(Y軸) Dim i ' ループカウンタ Dim oval ' オートシェイプ:円 Dim text ' オートシェイプ:テキストボックス For i = 1 To g_nCount n = ActiveSheet.Cells(i, 1) x = (g_nX_Origin + ActiveSheet.Cells(i, 2)) * g_nScale y = (g_nY_MAX - ActiveSheet.Cells(i, 3)) * g_nScale With ActiveSheet ' 点(○)を表示(X座標、Y座標、幅、高さ) Set oval = .Shapes.AddShape(msoShapeOval, x - 2, y - 2, 5, 5) oval.Fill.ForeColor.SchemeColor = 10 ' 色(赤)を指定 ' 番号を表示(X座標、Y座標、幅、高さ) Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x + 10, y - 5, 20, 15) text.Select Selection.Characters.text = CStr(n) text.Fill.Visible = msoFalse ' 非表示に text.line.Visible = msoFalse ' 非表示に End With Next End Sub ' 経路の描画 Sub DrawLine() Dim n ' データの番号 Dim x_st ' 線の開始位置(X軸) Dim y_st ' 線の開始位置(Y軸) Dim x_ed ' 線の終了位置(X軸) Dim y_ed ' 線の終了位置(Y軸) Dim i ' ループカウンタ Dim line ' オートシェイプ:線 For i = 1 To g_nPair GetXY ActiveSheet.Cells(i, 4), x_st, y_st GetXY ActiveSheet.Cells(i, 5), x_ed, y_ed x_st = (g_nX_Origin + x_st) * g_nScale y_st = (g_nY_MAX - y_st) * g_nScale x_ed = (g_nX_Origin + x_ed) * g_nScale y_ed = (g_nY_MAX - y_ed) * g_nScale With ActiveSheet ' 線を表示(X座標、Y座標、X座標2、Y座標2) Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed) End With Next End Sub ' 番号→座標の取得 Function GetXY(ByVal nPos, ByRef x, ByRef y) Dim n Dim i x = 0 y = 0 For i = 1 To g_nCount n = ActiveSheet.Cells(i, 1) If n = nPos Then x = ActiveSheet.Cells(i, 2) y = ActiveSheet.Cells(i, 3) Exit Function End If Next Exit Function End Function -サンプルファイル #ref(DrawGraph.xls); -グラフデータ #ref(GraphData.jpg); -実行結果 #ref(hatena_20040622.jpg); -はてな --http://www.hatena.ne.jp/1087797083 #comment