3
3

More than 5 years have passed since last update.

選択した図形を動かないように固定するPowerPointマクロ

Last updated at Posted at 2015-05-30

やりたいこと

MicrosoftのPowerPointで、貼り付けた絵などの大きさ、位置が
動かないように固定する方法はないでしょうか?
PowerPointで貼り付けた絵などを固定する

手動でマスターに図形を貼り付けるという方法が紹介されているけど、繰り返し操作するには面倒です。
そこで、これを自動でできるようにマクロ化しました。

選択した図形を固定するコード

Module1
'図形をロックする
Public Sub lockShapes()
    Dim sh As Shape
    Dim n As Integer, m As Integer, k As Integer

    'エラーチェック
    Call preCheck

    '選択した図形をカット
    ActiveWindow.Selection.ShapeRange.Cut

    'ダミーマスターを作る
    Call makeDummyMaster(n)

    '選択した図形をダミーマスターに貼り付け
    ActivePresentation.Designs(n).SlideMaster.Shapes.Paste

    '選択したスライドにダミーマスターを適用
    m = ActiveWindow.Selection.SlideRange.SlideIndex
    k = ActiveWindow.Selection.SlideRange.CustomLayout.index
    ActivePresentation.Slides(m).CustomLayout = ActivePresentation.Designs(n).SlideMaster.CustomLayouts(k)

    '余分なダミーマスターを削除
    Call cleanDummyMaster

    'ダミーマスターの名前を整理
    Call renameDummyMaster

End Sub

'エラーチェック
Private Sub preCheck()

    '表示がスライドでない時は終了
    If cView <> "Slide" Then
        Debug.Print "スライド表示でない"
        End
    End If

    '選択範囲がシェイプでないときは終了
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then
        Debug.Print "選択なし"
        End
    End If

End Sub


'ダミーマスターを作る
Private Sub makeDummyMaster(ByRef n As Integer)
    Dim i As Integer, j As Integer
    Dim d As Design

    i = ActiveWindow.Selection.SlideRange.SlideIndex
    j = ActivePresentation.Slides(i).Design.index

    Set d = ActivePresentation.Designs.Clone(ActivePresentation.Designs.item(j))

    d.Name = "DummyMST" & 0
    n = d.index

    Set d = Nothing

End Sub


'余分なダミーマスターを削除
Private Sub cleanDummyMaster()
    Dim d As Design
    Dim cl As CustomLayout
    Dim i As Integer
    Dim numD As Integer

    '不使用のダミーマスターを削除
    numD = ActivePresentation.Designs.Count
    For i = numD To 1 Step -1
        Set d = ActivePresentation.Designs(i)
        If InStr(d.Name, "DummyMST") <> 0 Then

            On Error Resume Next
            For Each cl In d.SlideMaster.CustomLayouts
                cl.Delete
            Next
            On Error GoTo 0

            If d.SlideMaster.CustomLayouts.Count = 0 Then d.Delete

        End If
    Next

    Set d = Nothing

End Sub

'ダミーマスターの名前修正
Private Sub renameDummyMaster()
    Dim d As Design
    Dim i As Integer

    i = 0
    For Each d In ActivePresentation.Designs
        If InStr(d.Name, "DummyMST") <> 0 Then
            i = i + 1
            d.Name = "DummyMST" & i & "tmp"
        End If
    Next

    i = 0
    For Each d In ActivePresentation.Designs
        If InStr(d.Name, "DummyMST") <> 0 Then
            i = i + 1
            d.Name = "DummyMST" & i
        End If
    Next

End Sub

'表示されているビュータイプを判定する関数
Private Function cView() As String
    Dim p As Pane

    For Each p In ActiveWindow.Panes
        If p.ViewType = ppViewSlide Then
            cView = "Slide"
            Exit Function
        ElseIf p.ViewType = ppViewSlideMaster Then
            cView = "Master"
            Exit Function
        End If
    Next
    cView = "Others"

End Function

使い方

  1. スライド上で、固定したい図形を選択します
  2. 上記マクロを実行します

固定した図形の戻し方

固定した図形を元に戻すには、スライドマスターから元のスライドに図形をカットアンドペーストすればいいです。
この部分はまだ自動化できてません。
この部分も自動化しました。

Module2
'ロックした図形を元に戻す
Public Sub unlockShapes()
    Dim i As Integer
    Dim sld As Slide, sh As ShapeRange

    Call preCheckMaster

    ActiveWindow.Selection.ShapeRange.Cut

    i = ActiveWindow.View.Slide.Design.index

    Call ShowSlide

    For Each sld In ActivePresentation.Slides
        If sld.Design.index = i Then
            Set sh = sld.Shapes.Paste
            sh.ZOrder msoSendToBack
            sh.Select
            Set sh = Nothing
            End
        End If
    Next

End Sub

'エラーチェック
Private Sub preCheckMaster()

    '表示がスライドでない時は終了
    If cView <> "Master" Then
        Debug.Print "マスター表示でない"
        End
    End If

    '選択範囲がシェイプでないときは終了
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then
        Debug.Print "選択なし"
        End
    End If

    'ダミースライド以外を選択しているときは終了
    If InStr(ActiveWindow.View.Slide.Design.Name, "DummyMST") = 0 Then
        Debug.Print "ダミースライドを選択していない"
        End
    End If

End Sub

'表示されているビュータイプを判定する関数
Private Function cView() As String
    Dim p As Pane

    For Each p In ActiveWindow.Panes
        If p.ViewType = ppViewSlide Then
            cView = "Slide"
            Exit Function
        ElseIf p.ViewType = ppViewSlideMaster Then
            cView = "Master"
            Exit Function
        End If
    Next
    cView = "Others"

End Function

使い方

  1. スライドマスター上で、固定を解除したい図形を選択します
  2. 上記マクロを実行します
3
3
1

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
3
3