PowerPointで図形を円周上に回転コピーする2つの方法

PowerPointで図形を放射状に回転コピーして配置する方法をご紹介します。

図形を複製と回転の繰り返しで円周上に並べるよりも、指定数の図形を円周上に一括配置できるツールを活用するのが効率的です。

今回は、SmartArtとマクロを使った回転コピーの神業を解説します。

この記事の目次

SmartArtで回転コピーする
マクロで回転コピーする
1. コード
2. 実行方法
もっと知りたい！SmartArtの神業
1. 放射状オブジェクトを作る
2. 漫画風集中線を作る

SmartArtで回転コピーする

作例

今回は、下図の作例ように星を円周上に12個配置した図形を作ります。

SmartArtで図形を円周上に配置する

図形を円周上に配置するときは、複製と回転の繰り返しでできますが効率的ではありません。PowerPointには自動で図形を円周上に並べてくれるツールがあるので活用しましょう。

「挿入」タブ →「図」グループ →「SmartArt」をクリックします。

「SmartArtグラフィックの選択」ダイアログボックスが開くので、「循環」→「基本の循環」を選択して「OK」をクリックします。

SmartArtがスライドに挿入されます。今回は、星が12個円周上に配置した図形を作りたいので、現在5個ある正円の数を7個増やします。

SmartArtを選択した状態で、「SmartArtツールのデザイン」タブ →「グラフィックの作成」グループの「図形の追加」を7回クリックして正円を追加します。

正円が12個になりました。

続いて、不要な図形を削除するためにSmartArtから図形に変換します。

SmartArtを選択した状態で、「SmartArtツールのデザイン」タブ →「SmartArtのスタイル」グループ →「変換」→「図形に変換」を選択します。

テキストが削除されて図形に変換されました。「Ctrl + Shift + G」キーのグループ化解除でも図形に変換できます。

すべての矢印を削除して正円だけ残します。この時、正円に白色の「1pt」の線幅が設定されているので「線なし」にしましょう。

図形の種類を変更する

すべての正円を選択し、「図形の書式」タブ →「図形の挿入」グループ →「図形の編集」→「図形の変更」→「星：5pt」を選択します。

正円が星に変わりました。

お好みの色に変更して完成です。

図形のサイズを変更する

図形一つ一つのサイズを変更する方法です。

グループ化している場合は「Ctrl + Shift + G」キーで解除し、図形をすべて選択します。

「図形の書式設定」ウィンドウ →「図形のオプション」→「サイズとプロパティ」→「サイズ」の「縦横比を固定する」にチェックを入れ、「高さ」または「幅」の値を変更します。

図形のサイズを縮小できました。

図形を自転させた状態にする

図形を自転させながら円周上に配置した状態にする方法です。

スマートな方法ではないですが、「360°÷図形の数」で角度を求めて図形を一つずつ回転させていく方法しかありません。

図形が12個の場合、右回りに「30°」ずつ増やしながら回転させていきます。

図形の回転は、「Alt + ← →」キーで「15°」ずつ回転させるか、「図形の書式設定」ウィンドウ →「図形のオプション」→「サイズとプロパティ」→「サイズ」→「回転」で行います。

回転させたあとで図形一つ一つのサイズを変更すると形が崩れてしまうので、回転はサイズが決まってから行いましょう。

マクロで回転コピーする

コード

Sub 回転コピー()

    Dim shp As Shape
    Dim slide As slide
    Dim centerX As Single
    Dim centerY As Single
    Dim radius As Single
    Dim angle As Single
    Dim numCopies As Integer
    Dim i As Integer
    
    '選択した図形を取得
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    '円の中心座標を設定（現在の図形の中心）
    centerX = shp.Left + shp.Width / 2
    centerY = shp.Top + shp.Height / 2
    
    '半径を入力ボックスで指定（cm単位）
    radius = InputBox("円の半径をcmで入力してください。")
    
    '複製する図形の数を入力ボックスで指定
    numCopies = InputBox("複製する図形の数を入力してください。")
    
    '角度を計算
    angle = 360 / numCopies
    
    '図形を複製・回転して円周上に配置
    For i = 1 To numCopies
        Dim newShp As Shape
        Set newShp = shp.Duplicate.Item(1)
        newShp.Left = centerX + (radius * 28.3465) * Cos((angle * i) * (3.14159 / 180)) - newShp.Width / 2
        newShp.Top = centerY + (radius * 28.3465) * Sin((angle * i) * (3.14159 / 180)) - newShp.Height / 2
        newShp.Rotation = angle * i + 90
    Next i
    
End Sub