#contents
*Excel 関連情報
**サンプルコード
***オートシェイプの使い方
-オートシェイプを使って線を描画するサンプル（その２）
 ' オートシェイプを使って線を描画するサンプル（その２）
 ' ＜テストデータ＞
 ' 番号、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
トップ   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS