エクセルの自動グラフ化マクロ

7201 ワード
VBA,Excel VBA VBAマクロ VBA テキストリンク

エクセルでよくグラフ化する学生、研究生のための自動グラフ化マクロを作成した

ゼミや研究室の進捗報告、学会発表、論文の執筆など、グラフを作成する場面は研究でたくさんありまよね、
実験で得られたデータをエクセルでグラフ化している人も多いのではないかと思います。
エクセルで作成されるグラフは、学会の要旨や論文のテンプレートにあったものではなく、
毎回文字の大きさなどの仕様を変更するのが面倒だったので、
比較的どの論文の仕様にもあった(理工系しかわかりませんが)、
グラフを自動で作成するマクロを組んでみました。

このマクロを適当なショートカットキーに割り当てれば、
マウスを使わずグラフ化が完結します。
(エクセルでもできますが、とにかくフォーマットが、、論文や発表用には使えない！)
慣れればめちゃめちゃ速くできます。

初投稿です、試しにやってみようかな、くらいのモチベーションで書いてますので、
コードのコメントなどは、リクエストがあったら書いていこうと思います。

この記事の方法以外にも、いろいろなデータ形式(凡例が多い場合、x軸はすべての凡例で同じデータを参照するとき、etc...)用のコードもあるので、
それもリクエストがあればまた記事にしたいと思います。
VBAはこのコードを書くまでは、まったく触れたことがなかったので、
見る人が見ればきったないかと思いますが、
使えればいいや、、精神ですので、、、あたたかく、、、、お願いします。

利用方法


例として、位相が90°ずれた2つの正弦波(sin波、cos波)をグラフ化します。
エクセルには、このようにそれぞれの正弦波で、x軸データ、y軸データを用意します。
今回は、それぞれ360°までのデータを用意しました(上図は5°までですが、実際は360°まであります)。
データが用意できたところでマクロを実行します。


今回は、新しいシートにグラフを作成する仕様にしているので、グラフのシート名を入力します。
英語は適当です。
後ろに移っているグラフも、ほんとにグラフ化されるのかよ。って感じですが、いずれされるので我慢で。


x軸のデータを選択します。エクセルでグラフ化するときのようにセルを選択すれば大丈夫です。
みなさんご存知だとは思いますが、範囲選択したいセルの先頭をクリックして選択した状態で、
Ctrl+Shift+↓　のコマンドで連続したセルの下端まで一気に選択されるの便利ですよね！
このコマンドで0~360°まで一気に選択して、OKクリック(Enterキーでもok)


次に、x軸と同じように、y軸のデータも選択します。選択し、OK


x軸、y軸のデータがそれぞれ選択できたら、次は軸ラベル名の入力です。
今回は、一応角度にしました。正弦波だから時間だろ、とかは思うだけにしてください


次はもうお分かり、y軸の軸ラベル名の入力です。
ちなみに名前の入力は、日本語・英語、両方できるアピールでここでは英語にしてます。
こまったら任意単位にするのはあるあるですかね？


ここは凡例名を入力します。
凡例が1つの場合も凡例名を入力する必要がありますが、
グラフ化されたときに凡例名は非表示になりますので、適当に「あああ」でもなんでも。


凡例1(sin波)の情報(選択した軸データや凡例名)が正しかったか聞かれます。
なくてもいいかと思いますが、意外に使っていて便利だった機能です。


他に凡例があるか聞かれます。凡例が1つのグラフは、ここでいいえをクリックすれば完了です。
今回は、cos波も表示したいので、はいを選択。


2つ目の凡例のx軸データを選択します。
1つ目の凡例と同様に、この後y軸データを選択し、凡例名の入力があります。
3つ以上の凡例がある場合も、同様に追加していきます。
グラフ化したい凡例すべての入力がおわれば、
do you have another siries?
でいいえをクリックすればグラフ化完了です。


こうなります。

ソースコード

Sub Graph_auto_maker()
    FontSize = 20
    sheetname_main = ActiveSheet.Name
    Dim chart1 As Chart
    Set chart1 = Charts.Add(Before:=ActiveSheet)
    buf = InputBox("Name of new graph sheet")
    chart1.Name = buf
    ActiveChart.ChartType = xlXYScatterLinesNoMarkers
    sheetname = ActiveChart.Name

    Sheets(sheetname_main).Select
Select_X_region:
    X_region = Select_cellRegion("X")
    Sheets(sheetname_main).Select
    Range(X_region).Select
Select_Y_region:
    Y_region = Select_cellRegion("Y")

    Charts(sheetname).Select
    With ActiveChart
      .ChartArea.Select
      .SetSourceData Source:=Range(Y_region)
      .FullSeriesCollection(1).XValues = X_region
      .ChartArea.Format.Line.Visible = msoFalse

      With .PlotArea.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
      End With


      With .Axes(xlCategory)
         .HasTitle = True
         buf = InputBox("X axis label")
         .AxisTitle.Text = buf
         .AxisTitle.Font.Size = FontSize
         .AxisTitle.Font.Bold = False
         .Format.Line.ForeColor.RGB = RGB(0, 0, 0)
         .TickLabels.Font.Size = FontSize
         .HasMajorGridlines = False
         .MajorTickMark = xlInside
      End With

      With .Axes(xlValue)
         .HasTitle = True
         buf = InputBox("Y axis label")
         .AxisTitle.Text = buf
         .AxisTitle.Font.Size = FontSize
         .AxisTitle.Font.Bold = False
         .Format.Line.ForeColor.RGB = RGB(0, 0, 0)
         .TickLabels.Font.Size = FontSize
         .HasMajorGridlines = False
         .MajorTickMark = xlInside
      End With


      buf = InputBox("Name of Siries 1")
      .SeriesCollection(1).Name = buf

      Language = MsgBox("Was series1 setting correct?", vbYesNo + vbQuestion)
      If Language = vbNo Then
         GoTo Select_X_region
      End If


      .Legend.Format.TextFrame2.TextRange.Font.Size = FontSize
      .HasTitle = True

      .ChartTitle.Delete

    End With

    i = 2
    While True

        rc = MsgBox("Do you have another of other siries？", vbYesNo + vbQuestion)
        If rc = vbYes Then
Series:
          Sheets(sheetname_main).Select
          X_region = Select_cellRegion("X")
          Sheets(sheetname_main).Select
          Range(X_region).Select
          Y_region = Select_cellRegion("Y")
          Charts(sheetname).Select
          Set srs = ActiveChart.SeriesCollection.Add(Y_region)
          srs.XValues = Range(X_region)
          buf = InputBox("Name of Siries " + Str(i))
          srs.Name = buf

          Language = MsgBox("Was series" + Str(i) + "setting correct?", vbYesNo + vbQuestion)
          If Language = vbNo Then
            ActiveChart.SeriesCollection(i).Delete
            GoTo Series
          End If

          i = i + 1
        Else
          If i = 2 Then
            Charts(sheetname).Select
            ActiveChart.Legend.Delete
            GoTo WhileEnd
          Else
            GoTo WhileEnd
          End If
        End If
    Wend

WhileEnd:
    Charts(sheetname).Select

End Sub