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
  • グラフデータ
    GraphData.jpg
  • 実行結果
    hatena_20040622.jpg

添付ファイル: fileGraphData.jpg 486件 [詳細] filehatena_20040622.jpg 454件 [詳細] fileDrawGraph.xls 638件 [詳細]

トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2013-02-02 (土) 22:21:09 (1777d)