PowerPointでカラーコードに合わせて図形を塗りつぶす

環境

• PowerPoint for Mac 2016
• Macbook 無印（8Gメモリ、CoreM）
• macOS Big Sur 11.2.3

はじめに

パワーポイントでスライドを作る際、配色は重要な要素の一つです。
配色設定のwebツールを利用した際、カラーコードで表示されることが多いと思います。
そこで、今回のマクロは、コピペでうまく図形の色を変更できないか？と考えたものです。

デモ

円にカラーコードfb1e3を入力し、そのカラーコード通りに塗りつぶしが変更されます。

VBA完成図

Sub 図形中に記載のカラーコードに合わせて塗りつぶす()
    'シェイプが選択されていなければ、処理を中断する。
    If Not ActiveWindow.Selection.Type = ppSelectionShapes Then Exit Sub
    
    '選択中のスライド番号を取得
    n_slide = ActiveWindow.Selection.SlideRange.SlideIndex
    '選択中のシェイプ を取得
    n_shape = ActiveWindow.Selection.ShapeRange.Name
    '選択シェイプの文字を取得
    txt_shape = ActivePresentation.Slides(n_slide).Shapes(n_shape).TextFrame.TextRange.Text
    
    'カラーコード→RGBへの変換
    Red_clr = CInt(Val("&H" & Mid(txt_shape, 1, 2) & "&"))
    Blue_clr = CInt(Val("&H" & Mid(txt_shape, 5, 2) & "&"))
    Green_clr = CInt(Val("&H" & Mid(txt_shape, 3, 2) & "&"))
    'R-G-B で2桁ずつ出力(確認用)
    Debug.Print Red_clr & "-" & Green_clr & "-" & Blue_clr
     
     '色を塗りつぶす
     With ActivePresentation.Slides(n_slide).Shapes(n_shape)
        .Fill.ForeColor.RGB = RGB(Red_clr, Green_clr, Blue_clr)
        .Line.Visible = msoFalse
    End With
    
End Sub

説明

準備
パワーポイントで、任意の図形を挿入しておき、カラーコードをテキストとしてコピペしておきます。

その後、マクロは

1. 図形からテキストを抽出
2. テキスト（カラーコード）をRGBに変換
3. RGBで指定した色に図形を塗りつぶし
   の流れで作成します。

マクロの基本構造

Sub マクロ名()
プログラムの内容（Tabでインデント下げ）
'コメント
End Sub

がVBAの基本形です。
マクロ名にはスペースキーが使えません。

VBA基本形

Sub 図形中に記載のカラーコードに合わせて塗りつぶす ()

End Sub

シェイプ未選択の際の処理

シェイプが未選択の場合に処理を中断するために、以下のように書きます。

    'シェイプが選択されていなければ、処理を中断する。
    If Not ActiveWindow.Selection.Type = ppSelectionShapes Then Exit Sub

選択図形内の文字を取得する

一番ハマりました。
ActiveWindowでアクティブのウィンドウを選択できるならアクティブな図形はActiveShapeでは？と思ったのですが、そんな都合のいいことはないようです。

パワーポイントで選択した図形をVBA内で指定するためには、
プレゼンテーションの指定→スライドの指定→図形の指定
が必要です。
→はVBAでは.で記述していきます。
つまり、
ActivePresentation.Slides(スライド番号).Shapes(図形名)
となります。

さらに、図形→テキスト→テキストの範囲→なんというテキストがあるかを記述することによって図形内のテキストを取得することができました。

1. プレゼンテーションの指定
ActivePresentationで選択中のプレゼンテーションファイルを指定しています。

2. スライドの指定
Slides(スライド番号)でスライドを指定することができます。
スライド番号は、
プレゼンテーション→選択範囲→スライド→スライド番号の入れ子構造になっています。
そのため、選択図形のあるスライド番号は
ActiveWindow.Selection.SlideRange.SlideIndex
です。
このままではとても読みづらいので、n_slideという変数にしておきます。

n_slide = ActiveWindow.Selection.SlideRange.SlideIndex

3. 図形の指定
同様にして、図形はShapes(図形の名前)と指定できます。
図形の名前はプレゼンテーション→選択範囲→図形→図形の名前の入れ子構造なので、
ActiveWindow.Selection.ShapeRange.Name
です。これを同様にn_shapeと名付けました。

3. 以上を組み合わせて、図形中のテキストを抽出する
1〜3までを組み合わせると、
ActivePresentation.Slides(n_slide).Shapes(n_shape)
で図形を指定できます。
さらに、この図形からテキストを抽出する
.TextFrame.TextRange.Text
を加え、

'選択中のスライド番号を取得
     n_slide = ActiveWindow.Selection.SlideRange.SlideIndex
    '選択中のシェイプ名を取得
     n_shape = ActiveWindow.Selection.ShapeRange.Name
    '選択シェイプの文字を取得
     txt_shape = ActivePresentation.Slides(n_slide).Shapes(n_shape).TextFrame.TextRange.Text

以上が図形のテキストを抽出するコードです。

カラーコードをRGBに変換する

カラーコードとRGBの構造の基本
カラーコードは16進数でR(赤)、B(青)、G(緑)をそれぞれ2桁ずつで示しています。
RGBはR(赤)、G(緑)、B(青)をそれぞれ0~255までの数値（10進数）で指定しています。
RGBとは緑と青の色が入れ替わっているので注意してください。

すなわち、

1. 2桁ずつにカラーコードを分解
2. 16進数から10進数に変換
   することで、カラーコードをRGBに変換することができます

1. 2桁ずつにカラーコードを分解
文字列の抽出にはLEFT, RIGHT, MIDなどのメソッドがあります。
今回は桁数が常に一定であること、私がVBA初心者であること、などの理由から全部MIDにしました。
MID(元の文字列, 何番目の文字から, 何文字抽出するか)
の形式で指定できます。
すなわち
赤：Mid(txt_shape, 1, 2)
緑：Mid(txt_shape, 3, 2)
青：Mid(txt_shape, 5, 2)
で指定できます。

1. 16進数から10進数に変換
16進数から10進数に変換するには、
Val("&H" & 16進数 & "&")
を利用します。
Val()では文字列を数値型に変換しています。

1、2を合わせる
これをCInt()で整数型に変換を加えると下のようになりました。

   Red_clr = CInt(Val("&H" & Mid(txt_shape, 1, 2) & "&"))
   Blue_clr = CInt(Val("&H" & Mid(txt_shape, 5, 2) & "&"))
   Green_clr = CInt(Val("&H" & Mid(txt_shape, 3, 2) & "&"))
   'R-G-B で2桁ずつ出力
   Debug.Print Red_clr & "-" & Green_clr & "-" & Blue_clr

Debug.print以下で、R-G-Bの順にイミディエイトウィンドウに表示させて確認しています。

RGBで指定した色に図形を塗りつぶし

あとから図形の塗りつぶし以外にも大きさを揃えたりグラデーションを付けたくなるかもしれないので、Withを用いて書きました。
今回は枠線をなしにしています。

塗りつぶしは、図形を選択した後、塗りつぶし→前面色→RGBで色を指定の構造で指定します。
withと同行ActivePresentation.Slides(n_slide).Shapes(n_shape)は図形の指定
.Fill.ForeColor.RGB = RGB(Red_clr, Green_clr, Blue_clr)で図形の塗りつぶし設定
.Line.Visible = msoFalseで枠線をなしに設定しています。

   With ActivePresentation.Slides(n_slide).Shapes(n_shape)
       .Fill.ForeColor.RGB = RGB(Red_clr, Green_clr, Blue_clr)
       .Line.Visible = msoFalse
   End With

以上を合わせると、完成形のコードになります。

Sub 図形中に記載のカラーコードに合わせて塗りつぶす()
    'シェイプが選択されていなければ、処理を中断する。
    If Not ActiveWindow.Selection.Type = ppSelectionShapes Then Exit Sub
    
    '選択中のスライド番号を取得
    n_slide = ActiveWindow.Selection.SlideRange.SlideIndex
    '選択中のシェイプ を取得
    n_shape = ActiveWindow.Selection.ShapeRange.Name
    '選択シェイプの文字を取得
    txt_shape = ActivePresentation.Slides(n_slide).Shapes(n_shape).TextFrame.TextRange.Text
    
    'カラーコード→RGBへの変換
    Red_clr = CInt(Val("&H" & Mid(txt_shape, 1, 2) & "&"))
    Blue_clr = CInt(Val("&H" & Mid(txt_shape, 5, 2) & "&"))
    Green_clr = CInt(Val("&H" & Mid(txt_shape, 3, 2) & "&"))
    'R-G-B で2桁ずつ出力(確認用)
    Debug.Print Red_clr & "-" & Green_clr & "-" & Blue_clr
     
     '色を塗りつぶす
     With ActivePresentation.Slides(n_slide).Shapes(n_shape)
        .Fill.ForeColor.RGB = RGB(Red_clr, Green_clr, Blue_clr)
        .Line.Visible = msoFalse
    End With
    
End Sub