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
など、仲間捜しの条件は自由に変えられます。最後に注意点があります。グループ化されてないシェイプとグループ化されたものは仲間と見なしません。そのため、
と同じシェイプが並んでいるように見えますが、マクロを実行したら
と3だけ選択されない。なぜだろうと確認したら、
なんか違う。
あぁ、シェイプとテクストボックスがグループ化されてたのね。ということもあります。グループ化されたシェイプも考慮してマクロを書くこともできますが、コードが長くなるので説明は割愛。どうせスライド内のシェイプを全て選択し(ctrl + a もしくは ⌘ +a)、グループ化解除すれば動作しちゃうので。
さいごに
今回は条件の追加、組み合わせを紹介しました。私の記事に限らず、インターネットには様々なコードが公開・共有されています。そのまま使える状況はとてもありがたく、作成者に感謝すべきです。その上で、ちょっとでも修正して、自分なりのパーソナライズができるとVBAに限らず、コーディングは楽しくなります。
この記事が気に入ったらサポートをしてみませんか?