PowerPoint VBAで選択しているシェイプのフォントを変更するマクロの作り方

2018.09.302018.10.04

photo credit: Philippe Put word house selegie via photopin (license)

みなさん、こんにちは！
タカハシ(@ntakahashi0505)です。

PowerPoint VBAで選択している部分を操作するマクロの作り方をお伝えしています。

前回の記事はコチラ。

PowerPoint VBAで選択しているシェイプを操作するShapeRangeオブジェクト

PowerPoint VBAで選択している部分を操作するマクロの作り方についてお伝えしています。今回は、選択しているシェイプ範囲を操作するShapeRangeオブジェクトとその使い方について紹介をします。

選択しているシェイプを表すShapeRangeオブジェクトについて紹介しました。

今回は、そのShapeRangeのフォントを変更していきましょう。

PowerPoint VBAで選択しているシェイプのフォントを変更するマクロの作り方です。

行ってみましょう！

前回のおさらい
選択したシェイプのフォントを変更するプロシージャ
別解：ShapeRangeオブジェクトについてFor Each文でループを回す
まとめ
連載目次：初心者向けPowerPoint VBAで選択箇所を操作する

前回のおさらい

では、まず前回のおさらいから。

紹介したコードはこちらでした。

Sub 選択したシェイプの取得()

With ActiveWindow.Selection
    If .Type >= ppSelectionShapes Then
        Debug.Print "選択シェイプ数: " & .ShapeRange.Count
        .ShapeRange.Duplicate
    End If
End With

End Sub

4行目で、シェイプが選択されているかを判定、そして選択されていればそのシェイプの数をイミディエイトウィンドウに出力しつつ、選択シェイプ全てを複製するというものでした。

今回は、このプロシージャを修正して、選択しているシェイプのフォントを変更するマクロを作っていきます。

選択したシェイプのフォントを変更するプロシージャ

選択したフォントの変更をするプロシージャを作ってみましょう。

まず、インデックスを用いてFor文でループを回すパターンです。

Sub 選択したシェイプのフォントを変更()

With ActiveWindow.Selection
    If .Type >= ppSelectionShapes Then
    
        Dim i As Long
        For i = 1 To .ShapeRange.Count
            With .ShapeRange(i).TextFrame.TextRange.Font
                .Name = "Meiryo UI"
                .NameFarEast = "Meiryo UI"
                .Color = RGB(89, 89, 89)
            End With
        Next i
    
    End If
End With

End Sub

SlideRangeのときより簡単ですね。

ShapeRangeからインデックスでシェイプを取り出す

7行目～13行目で、選択しているシェイプについてループをしています。

シェイプ範囲に含まれるシェイプには1から順番にインデックスが振られていまして、以下書式でShapeオブジェクトとして取り出すことができます。

ShapeRangeオブジェクト(インデックス)

ループの回数は、Countプロパティで取得したシェイプの数までとすればOKです。

選択されている各シェイプのフォントを設定する

これで、選択されているShapeオブジェクトを一つずつ取り出すことができますので、そのFontオブジェクトを設定していけば良いですね。

詳細は以下の記事をご覧ください。

PowerPoint VBAでシェイプのフォント設定をする色々なプロパティまとめ

PowerPoint VBA入門編ということで、図形やテキストボックスのフォントを変更するマクロの作り方をお伝えしています。今回は、テキストのフォントを変更するいろいろなプロパティまとめをお伝えします。

実行結果

以下のように、シェイプを選択しているとしましょう。

この状態で前述のプロシージャを実行すると、以下のようになります。

別解：ShapeRangeオブジェクトについてFor Each文でループを回す

ShapeRangeオブジェクトも、SlideRangeオブジェクトと同様に、For Each文によりループを回すことができます。

以下コードでも前述のコードと同様の結果を得ることができます。

Sub 選択したシェイプのフォントを変更2()

With ActiveWindow.Selection
    If .Type >= ppSelectionShapes Then
    
        Dim shp As Shape
        For Each shp In .ShapeRange
            With shp.TextFrame.TextRange.Font
                .Name = "Meiryo UI"
                .NameFarEast = "Meiryo UI"
                .Color = RGB(89, 89, 89)
            End With
        Next shp
    
    End If
End With

End Sub

処理の順番にこだわらなければ、こちらのほうがわかりやすいかも知れませんね。