在宅仕事日記

在宅仕事日記

PR

Keyword Search

▼キーワード検索

Calendar

Profile

tanpopo3416

tanpopo3416

Comments

tanpopo3416 @ Re:Excel VBA グループ解除、再グループ化(07/20) 「VBA オートシェイプのグループを再帰的…
jone@ Re:Excel VBA グループ解除、再グループ化(07/20) ワークシート版も考えてみました。 図A,…
tanpopo3416 @ Re[1]:Excel VBA グループ解除、再グループ化(07/20) jone さんへ 「オートシェイプをコピーし…
tanpopo3416 @ Re:Excel VBA グループ解除、再グループ化(07/20) コメントありがとうございます。 >図…
jone@ Re:Excel VBA グループ解除、再グループ化(07/20) 私も挑戦していました。久しぶりのプログ…

Freepage List

Sep 24, 2020
XML
カテゴリ: Excel VBA

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
    Next
End Sub





お気に入りの記事を「いいね!」で応援しよう

Last updated  Sep 24, 2020 09:38:39 PM
コメント(0) | コメントを書く


【毎日開催】
15記事にいいね!で1ポイント
10秒滞在
いいね! -- / --
おめでとうございます!
ミッションを達成しました。
※「ポイントを獲得する」ボタンを押すと広告が表示されます。
x
X

© Rakuten Group, Inc.
X
Mobilize your Site
スマートフォン版を閲覧 | PC版を閲覧
Share by: