在宅仕事日記

グラフのフォントを変更する Excel VBA マクロ

グラフの多いExcelのレイアウト作業を行いました。Arialフォント指定ですが、グラフのフォントの種類を変更するだけでも大変。そこでマクロを作ってみました面倒な作業は、マクロを作ったら楽だろうとよく思います。そういうマクロに限って、作るのが難しいのです。VBAのオンライン講座を受講したり、書籍でも勉強しました。でも、グラフや図形を扱うマクロは学んでいません。記録マクロでヒントをさがしたり、ネットで調べて作ってみるのです。グラフは初めてのオブジェクトです。一から学んで作ればよいけど、仕事なので勉強している時間はありません。知識が足りない状態で、調べつつコードを書きました。仕事のマクロを作るときに迷うのは、動くマクロが完成するのかさえ分からないことです。面倒だからマクロを作りたい。でも、作るのに時間をかけると、納期までの作業時間が少なくなります。短時間でコードを完成させなければなりません。バージョン2013で作成したコードを、参考のため貼り付けておきます。コメントにも書いていますが、2010ではエラーになります。もっとシンプルに書けるはずだけど、時間の関係で、動くマクロをとりあえず作りました。これからグラフのマクロについて勉強して、もっと良いコードに修正してみたいと思います。Sub AllSheetGraphFontSet()    Dim chrt As ChartObject    Dim c As Long    Dim ws As Worksheet    Dim dtLabel As DataLabel    Dim shp As Shape        For Each ws In Worksheets        For c = 1 To ws.ChartObjects.Count             With ws.ChartObjects(c).Chart                If .HasTitle Then                    .ChartTitle.Format.TextFrame2.TextRange.Font.Name = "Arial"                End If                If .HasLegend Then                    .Legend.Format.TextFrame2.TextRange.Font.Name = "Arial"                End If                If .HasAxis(xlCategory) Then                    .Axes(xlCategory).TickLabels.Font.Name = "Arial"                End If                If .HasAxis(xlValue) Then                     .Axes(xlValue).TickLabels.Font.Name = "Arial"                End If                                If .HasAxis(xlSeriesAxis) Then                     .Axes(xlSeriesAxis).TickLabels.Font.Name = "Arial"                End If                                If .HasAxis(xlValue, xlSecondary) Then                     .Axes(xlValue, xlSecondary).TickLabels.Font.Name = "Arial"                End If                                                For i = 1 To .SeriesCollection.Count                    If .SeriesCollection(i).HasDataLabels Then                        For Each dtLabel In .FullSeriesCollection(i).DataLabels                            'FullSeriesCollectionは、バージョン2010でエラーになる。代わりにSeriesCollectionを使う                            .FullSeriesCollection(i).DataLabels.Format.TextFrame2.TextRange.Font.Name = "Arial"                        Next                    End If                Next                For Each shp In .Shapes                   shp.TextFrame2.TextRange.Font.Name = "Arial"                Next            End With        Next    NextEnd Sub