Home » パワーポイントマクロ・PowerPoint VBAの使い方 » Shapesコレクション・Shapeオブジェクト » 選択されている図形と同じ形状の図形をすべて選択するパワポマクロ

選択されている図形と同じ形状の図形をすべて選択するパワポマクロ

対象:PowerPoint2007, PowerPoint2010, PowerPoint2013

PowerPointで資料を作成しているときに、同じ形状の図形だけをすべて選択したい、ということが頻繁にありました。

あまりに頻繁に発生するので、アクティブなスライド上に存在する、同じ形状の図形だけをすべて選択するマクロを作成しましたので、ご紹介しておきます。

[スポンサードリンク]

アクティブスライドで選択されている図形と同じ形の図形をすべて選択するサンプルマクロ

さまざまな形状の図形が存在するスライドで、図形を一つ選択しておいて以下のマクロを実行すると、その選択されていた図形と同じ形状の図形だけをすべて選択することができます。

Sub 選択図形と同じ図形だけを選択する()
 On Error GoTo ErrHandl
 
 With ActiveWindow.Selection
  If .Type <> ppSelectionShapes Then Err.Raise 999
  If .ShapeRange.Count <> 1 Then Err.Raise 999
 
  Dim typ As MsoAutoShapeType
  typ = .ShapeRange.AutoShapeType

  Dim shp As Shape
  For Each shp In .SlideRange.Shapes
   If shp.AutoShapeType = typ Then
    shp.Select Replace:=msoFalse
   End If
  Next shp
 End With
 
 Exit Sub
 
ErrHandl:
 Select Case Err.Number
  Case 999
   MsgBox "アクティブスライド上で、図形を1つだけ選択してから実行してください。"
  Case Else
   MsgBox Err.Description & vbCrLf & Err.Number
 End Select
 Err.Clear
End Sub

サンプルマクロの解説

選択されている図形のAutoShapeTypeプロパティを、変数typに格納しておいてから、
  Dim typ As MsoAutoShapeType
  typ = .ShapeRange.AutoShapeType

アクティブスライド上の全図形に対するFor Each~Nextループの中で、
  Dim shp As Shape
  For Each shp In .SlideRange.Shapes

各ShapeのAutoShapeTypeと比較して合致したら、
   If shp.AutoShapeType = typ Then

選択を行っています。
    shp.Select Replace:=msoFalse

図形が選択されていないときや、
  If .Type <> ppSelectionShapes Then Err.Raise 999
複数の図形が選択されているときには、
  If .ShapeRange.Count <> 1 Then Err.Raise 999

メッセージを表示します。
 ErrHandl:
  Select Case Err.Number
   Case 999
   MsgBox "アクティブスライド上で、図形を1つだけ選択してから実行してください。"

最終更新日時:2018-10-22 18:59

[スポンサードリンク]

Home » パワーポイントマクロ・PowerPoint VBAの使い方 » Shapesコレクション・Shapeオブジェクト » 選択されている図形と同じ形状の図形をすべて選択するパワポマクロ

「Shapesコレクション・Shapeオブジェクト」の記事一覧

検索


Copyright © インストラクターのネタ帳 All Rights Reserved.

.