読者です 読者をやめる 読者になる 読者になる

CGメソッド

CG制作に関してのヒント

MENU

【PowerPoint】図形をA4にリサイズして、A4スライドにぴったり合わせるマクロ

PowerPoint

複数のA4のパワポデータを一つのパワポにまとめて印刷するために、pptデータをpptデータへひたすらドラック&ドロップ&リサイズをしていたのですが、

マクロ書いとけばよかったということで、リサイズの部分だけ書いてみました(参考をくっつけただけです)

追記

こちらのマクロで一発で解決できることを忘れていました。

min.hatenablog.jp

図形をA4にリサイズして、A4スライドにぴったり合わせるマクロ

Sub resizeA4()

''図形をA4にリサイズ

takasa = 28.355 * 19.05:   '高さ指定。5.3cm
haba = 28.355 * 27.51: '幅指定。7.07cm

With ActiveWindow.Selection

If .Type = ppSelectionNone Or _
.Type = ppSelectionSlides Then Exit Sub

With .ShapeRange

.LockAspectRatio = msoFalse: '縦横比を固定をしない。

.Height = takasa: '高さ設定

.Width = haba: '幅設定

'縦横比を固定にしたい場合は.LcokAspect~の行を削除し、
'幅基準(高さはなり)ならば、.Heightの行も削除する。

End With
End With

''図形を中心に移動

  Dim sld_w As Single ''スライドの横幅
  Dim sld_h As Single ''スライドの高さ
  Dim shp_w As Single ''Shapeの横幅
  Dim shp_h As Single ''Shapeの高さ
  Dim msg As String

  With ActiveWindow.Selection

    ''図形が選択されていない場合はマクロを終了
    If .Type = ppSelectionNone _
    Or .Type = ppSelectionSlides Then
      msg = "中央に配置したいShapeを選択してください。"
      MsgBox msg
      Exit Sub
    End If

    ''スライドのサイズを取得
    sld_w = .SlideRange.Master.Width
    sld_h = .SlideRange.Master.Height

    ''図形のサイズを取得
    shp_w = .ShapeRange.Width
    shp_h = .ShapeRange.Height

    ''図形の位置を移動
    .ShapeRange.Left = (sld_w - shp_w) / 2
    .ShapeRange.Top = (sld_h - shp_h) / 2

  End With

End Sub

参考

パワーポイント2010で画像のマクロ - 画像編集・動画編集・音楽編集 締切済 | 教えて!goo

選択されたShapeをスライドの中央・中心に配置するパワポマクロ:パワーポイントマクロ・PowerPoint VBAの使い方-Shape・図形