PowerPoint 一覧

PowerPoint VBA 【005】目次生成

2015/9/5

PowerPointには残念ながらWordのような目次を自動生成する機能がありません。
そこで、以下の方法で目次の作成を行います。

①見出し設定(PowerPoint)
見出しにしたい、テキストボックスのオブジェクト名に
ラベルを設定する。１から５のレベルを設定できます。
・設定用PowerPointアドインマクロも用意してます。（現在準備中）
以下の様に、設定してもＯＫです。
標準機能で設定できます。

②見出し抽出(Excel)
オブジェクト名にラベルが設定された見出し、
スライド番号(ページ)を抽出し、目次の生成を行う。
（現在準備中）

③目次貼付(あなたの手)
②で生成した目次をコピー＆ペーストで貼り付ける。
表形式のまま貼付を行ってください。

※テキスト形式での貼付でも問題ないが、
後述のＰＤＦしおり作成で利用できないので注意！

目次生成は以上です。

PowerPoint VBA 【004】図形変更（グループ化）

2015/11/11

グループ化されたオブジェクトの処理を追加しました。

フォント変更と同様に【003】ではグループ化されたオブジェクトが
対象になりません。

Sub PPT004()
    Dim sld As Slide
    Dim shp As Shape
    '***** 選択した全スライド
    For Each sld In ActiveWindow.Selection.SlideRange
      '***** 全シェイプ
        For Each shp In sld.Shapes
            '*** グループ化されているオブジェクト
            If (shp.Type = msoGroup) Then
                Call grp_proc(shp)
            Else
                'オートシェイプの処理
                Call shape_proc(shp)
            End If
        Next shp
    Next sld
End Sub

全スライドを対象にするには

    '***** 全スライド
    For Each sld In ActivePresentation.Slides

グループ化の処理です。
グループ化されているオブジェクトがなくなるまで
繰り返します。

Sub grp_proc(shp As Shape)
    '***** グループ化されている場合の処理 *****
    Dim grp As Shape
    '*** グループ内のオブジェクト分繰り返す
    For Each grp In shp.GroupItems
        'さらにグループ化されている
        If (grp.Type = msoGroup) Then
            Call grp_proc(grp)
        Else
            'オートシェイプの処理
            Call shape_proc(grp)
        End If
    Next grp
End Sub

オブジェクト変更の処理です。
ここで実際の更新処理を行ってます。

Sub shape_proc(shp As Shape)
    '***** シェイプの処理 *****
    If (shp.Type = msoAutoShape) Then
        '正方形／四角形で枠線が黒色
        If (shp.AutoShapeType = msoShapeRectangle) And _
           (shp.Line.ForeColor.RGB = RGB(0, 0, 0)) Then
            '枠線を赤色に変更
            shp.Line.ForeColor.RGB = RGB(255, 0, 0)
        End If
    End If
End Sub

オブジェクト変更部分、とグループ化の処理は
同じ処理を何度か書く必要があるので、ルーチン化しました。
構造化プログラミングです。

グループ化の処理は再帰化ロジックとなってます。
（自分で自分をコールしてます）

PowerPoint VBA 【003】図形変更

2015/11/11

選択したスライドの図形を一括変更するVBAを作成しました。

選択されたスライドでを持っているオブジェクトについて
指定したフォント以外の場合、フォントを変更しています。

Sub PPT003()
    Dim sld As Slide
    Dim shp As Shape
    '***** 選択した全スライド
    For Each sld In ActiveWindow.Selection.SlideRange
      '***** 全シェイプ
        For Each shp In sld.Shapes
            'オートシェイプ対象
            If (shp.Type = msoAutoShape) Then
                '正方形／四角形で枠線が黒色
                If (shp.AutoShapeType = msoShapeRectangle) And _
                   (shp.Line.ForeColor.RGB = RGB(0, 0, 0)) Then
                    '枠線を赤色に変更
                    shp.Line.ForeColor.RGB = RGB(255, 0, 0)
                End If
            End If
        Next shp
    Next sld
End Sub

全スライドを対象にするには

    '***** 全スライド
    For Each sld In ActivePresentation.Slides

例では枠線の色を変更してますが、
他の属性に変更したり、いろいろ応用出来ると思います。

PowerPoint VBA 【002】フォント変更(グループ化)

2015/9/5

【００１】で出来たと思いましたが、まだ完璧ではありませんでした。
単純なオブジェクトはこれでＯＫですが、
グループ化されているオブジェクトはＮＧでした。

グループ化されたオブジェクトのがある場合のロジックを追加します。
本当にこのような方法しかないのか？ですが。。。

ExcelやWordでもこんな事、したかな？
最近、PowerPoint以外触ってないので、忘れましたが、
こんな事しなくてもオブジェクトで拾えたように思います。

Sub PPT002()
    Dim sld As Slide
    Dim shp As Shape
    Dim wkstr As String
    '***** 選択スライド
    For Each sld In ActiveWindow.Selection.SlideRange
        '***** 全シェイプ
        For Each shp In sld.Shapes
            '*** テキストフレームを持っているオブジェクト ***
            If (shp.HasTextFrame = msoTrue) And _
               (shp.TextFrame.HasText = msoTrue) Then
                Call text_proc(shp)
            End If
            '*** グループ化されているオブジェクト
            If (shp.Type = msoGroup) Then
                Call grp_proc(shp)
            End If
        Next shp
    Next sld
End Sub

Sub text_proc(shp As Shape)
        If (shp.TextFrame.TextRange.Font.Name <> "Times New Roman") Then
            shp.TextFrame.TextRange.Font.Name = "Times New Roman"
        End If
        If (shp.TextFrame.TextRange.Font.NameFarEast <> "ＭＳ 明朝") Then
            shp.TextFrame.TextRange.Font.NameFarEast = "ＭＳ 明朝"
        End If
End Sub

Sub grp_proc(shp As Shape)
    Dim grp As Shape
    '*** グループ内のオブジェクト分繰り返す
    For Each grp In shp.GroupItems
        ' テキストを保有しているオブジェクト
        If (grp.HasTextFrame = msoTrue) And _
           (grp.TextFrame.HasText = msoTrue) Then
           Call text_proc(grp)
        End If
        'さらにグループ化されている
        If (grp.Type = msoGroup) Then
            Call grp_proc(grp)
        End If
    Next grp
End Sub

フォント変更部分、とグループ化の処理は
同じ処理を何度か書く必要があるので、ルーチン化しました。
構造化プログラミングです。

グループ化の処理は再帰化ロジックとなってます。
（自分で自分をコールしてます）

PowerPoint VBA 【001】フォント変更

2015/9/21

選択したスライドのフォントを一括変更するVBAを作成しました。

選択されたスライドのテキストを持っているオブジェクトについて
指定したフォント以外の場合、フォントを変更しています。

Sub PPT001()
    Dim sld As Slide
    Dim shp As Shape
    '***** 選択した全スライド
    For Each sld In ActiveWindow.Selection.SlideRange
        '***** 全シェイプ
        For Each shp In sld.Shapes
            '*** テキストフレームを持っている ***
            If (shp.HasTextFrame = msoTrue) And _
                (shp.TextFrame.HasText = msoTrue) Then
                '*** 英字フォントを「Times New Roman」に統一
                shp.TextFrame.TextRange.Font.Name = "Times New Roman"
                '*** 日本語フォントを「ＭＳ 明朝」に統一
                shp.TextFrame.TextRange.Font.NameFarEast = "ＭＳ 明朝"
            End If
        Next shp
    Next sld
End Sub

例ではフォントを変更してますが、
色やサイズ等の属性やテキストを修正したり
いろいろ応用出来ると思います。

全スライドを対象にするには

    '***** 全スライド
    For Each sld In ActivePresentation.Slides

スポンサーリンク
スポンサーサイト