11.シェイプの仲間探しを深掘り

前回は、スライド内にある同じ色のシェイプ(図形)を自動的に選ぶマクロを紹介しました。仲間捜しの条件が"塗りつぶし(=Fill)"だけなので、

と塗りつぶしが同じシェイプが並んでいる場合、左端のシェイプ(1)を選択し、

前回のマクロ

Sub 同色シェイプ選択()
  Dim shp As Shape
  Dim f_rgb As Long
  Dim l_rgb As Long

With ActiveWindow.Selection
    ' 未選択もしくはスライド選択は対象外
    If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then Exit Sub
    ' 選択シェイプの色を取得
    f_rgb = .ShapeRange.Fill.ForeColor.RGB
    l_rgb = .ShapeRange.Line.ForeColor.RGB
    ' スライドのシェイプで
    For Each shp In .SlideRange.Shapes
    ' 色が一致するものを選択
      If shp.Fill.ForeColor.RGB = f_rgb And shp.Line.ForeColor.RGB = l_rgb Then
    ' 複数選択(＝選択置き換えせず)
        shp.Select Replace:=msoFalse
      End If
    Next shp
  End With 
End Sub

を実行すると

と全て選択されます。これで良いでしょ。という意見と、

「枠線が異なる真ん中の3は外したい。」

という要望もあるでしょう。そこで、枠線(=Line)も考慮して絞り込みたい時は、次のコードです

Sub 同色シェイプ選択拡張()

  Dim shp As Shape
  Dim f_rgb As Long
  Dim l_rgb As Long

With ActiveWindow.Selection

    ' 未選択もしくはスライド選択は対象外
    If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then Exit Sub

    ' 選択シェイプの塗りつぶしと枠線の色を取得
    f_rgb = .ShapeRange.Fill.ForeColor.RGB
    l_rgb = .ShapeRange.Line.ForeColor.RGB

    ' スライドのシェイプで
    For Each shp In .SlideRange.Shapes

    ' 色が一致するものを選択
      If shp.Fill.ForeColor.RGB = f_rgb And shp.Line.ForeColor.RGB = l_rgb Then

    ' 選択置き換えせず＝複数選択
        shp.Select Replace:=msoFalse
      End If
    Next shp
  End With

End Sub

同じ手順で実行すると、

と枠線も考慮します。もちろん、塗り潰しは気にせず、枠線だけを選択条件にすることも可能です。では、次の場合はどうでしょう？

 左上の正方形を選んで、マクロを実行すると

塗り潰しと枠線を条件にしているため、全て選んじゃいます。
こういうケースでは、同じ正方形だけ選択したいですよね。そこで、塗りつぶし・枠線、さらにシェイプの種類(=AutoShapeType)を絞り込みたい時は、

Sub 同色同形シェイプ選択()

  Dim shp As Shape
  Dim f_rgb As Long
  Dim l_rgb As Long
  Dim s_type As Variant

With ActiveWindow.Selection

    ' 未選択もしくはスライド選択は対象外
    If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then Exit Sub

    ' 選択シェイプの塗りつぶしと枠線の色を取得
    f_rgb = .ShapeRange.Fill.ForeColor.RGB
    l_rgb = .ShapeRange.Line.ForeColor.RGB
    ' 選択シェイプのタイプを取得
    s_type = .ShapeRange.AutoShapeType
   

    ' スライドのシェイプで
    For Each shp In .SlideRange.Shapes
    
    ' 色とタイプが一致するものを選択
      If shp.Fill.ForeColor.RGB = f_rgb And shp.Line.ForeColor.RGB = l_rgb _
      And shp.AutoShapeType = s_type Then

    ' 選択置き換えせず＝複数選択
        shp.Select Replace:=msoFalse
      End If
    Next shp
  End With

End Sub

です。同じく左上の正方形を選んでこのマクロを使うと、

と正方形のみ選び、

と簡単に色の塗り潰しが行えます。このコードに手を加え、

塗りつぶし And タイプ

If shp.Fill.ForeColor.RGB = f_rgb And shp.AutoShapeType = s_type Then

枠線 And タイプ

If shp.Line.ForeColor.RGB = l_rgb And shp.AutoShapeType = s_type Then

など、仲間捜しの条件は自由に変えられます。最後に注意点があります。グループ化されてないシェイプとグループ化されたものは仲間と見なしません。そのため、

と同じシェイプが並んでいるように見えますが、マクロを実行したら

と３だけ選択されない。なぜだろうと確認したら、

なんか違う。

あぁ、シェイプとテクストボックスがグループ化されてたのね。ということもあります。グループ化されたシェイプも考慮してマクロを書くこともできますが、コードが長くなるので説明は割愛。どうせスライド内のシェイプを全て選択し（ctrl + a もしくは ⌘ +a）、グループ化解除すれば動作しちゃうので。

さいごに

今回は条件の追加、組み合わせを紹介しました。私の記事に限らず、インターネットには様々なコードが公開・共有されています。そのまま使える状況はとてもありがたく、作成者に感謝すべきです。その上で、ちょっとでも修正して、自分なりのパーソナライズができるとVBAに限らず、コーディングは楽しくなります。