2016年5月7日土曜日

Excelでチャートを作成するVBAの雛型

1. 出来上がりのイメージ

 Excel VBAでチャートの作成を自動化したいので、チャートを作成するプログラムの練習をします。最終的な自動化のプログラムではなく、いろんな機能を試した時のソースコードを説明します。
 まず、出来上がりの画面です。





2. ソースコードの説明

 あまり細かい説明はしないのですが、このようなコードでチャートを作成しました。だいたい、これくらいの機能が使えれば、狙ったチャートを作れると思います。最終的には、Accessデータベースに保存したデータを読み込んで、チャート化してpptに貼るという一連のプログラムを作りたいと思います。


Private Sub Chart_Create_Button_Click()

    Dim size As Integer
    Dim ShapeObj As Shape
    Dim SeriesObj As Series
    Dim ScObj As SeriesCollection
    Dim ChartObj As Chart
    Dim XaxisObj As Axis
    Dim YaxisObj As Axis
    
    Dim x_index As Integer
    Dim y_index As Integer
    
    x_index = 0
    y_index = 0
    size = 300
    
    
    Set ShapeObj = ActiveSheet.Shapes.AddChart(xlXYScatter, x_index * size * 1.2, y_index * size, size * 1.2, size)
    
    Set ChartObj = ShapeObj.Chart
    Set ScObj = ChartObj.SeriesCollection
    
    Set SeriesObj = ScObj.NewSeries
   
    'データを設定する
    SeriesObj.XValues = DataGen(20)
    SeriesObj.Values = DataGen(20)
       
    SeriesObj.Name = "test_name1"
    
    
    Set SeriesObj = ScObj.NewSeries
   
    'データを設定する
    SeriesObj.XValues = DataGen(20)
    SeriesObj.Values = DataGen(20)
       
    SeriesObj.Name = "test_name2"
    
    
    Set Xaxis = ChartObj.Axes(xlCategory)
    Set Yaxis = ChartObj.Axes(xlValue)
    
    
   '横軸ラベルを設定する
    With Xaxis
        .HasTitle = True
        .AxisTitle.Text = "test_Axis_x"
    End With
    
    '縦軸ラベルを設定する
    With Yaxis
        .HasTitle = True
        .AxisTitle.Text = "test_Axis_y"
    End With

    Xaxis.MaximumScale = 2
    Xaxis.MinimumScale = -1
    Yaxis.MaximumScale = 2
    Yaxis.MinimumScale = -1
    
    
    ChartObj.SetElement (msoElementPrimaryCategoryGridLinesMajor)
    
    Xaxis.TickLabelPosition = xlLow
    Yaxis.TickLabelPosition = xlLow
    
    With ChartObj
        .HasTitle = True
        .ChartTitle.Text = "ChartTitle"
    
    End With
    
End Sub

Public Function DataGen(data_width As Integer) As Double()
    Dim i As Integer
    Dim DataArray() As Double
    
    
    ReDim DataArray(data_width)
    
    For i = 0 To data_width - 1
        DataArray(i) = Rnd()
    Next

    DataGen = DataArray
End Function



0 件のコメント:

コメントを投稿