PowerPointのマクロを使ってスライドを日時順にソートしてみた

あなたは、パワーポイントで、スライドをソートしたいと思ったことはありませんか?

僕は、最近、ソートしたいことが出てきました。
そこで、マクロを使って日時順にソートしてみました。

パワーポイントのスライドをソートしたくなった

僕は、最近、パワーポイントを使って情報カードを作成するようになりました。
手書きをするより早く綺麗に作成できるので、最近は、もっぱらパワーポイントを使って作成しています。おすすめです。

ところで、僕が使うPCは複数台あります。
その中で、情報カードを入力するPCを取り立てて決めているわけではありません。全てのPC上で、気が向いたときに作成しています。

ただ、印刷するプリンタはEPSON EW-M571Tの1台に決めています。印刷コストが安いからです。

印刷後のスライドは、一つのファイルに集めるようにしています。
ここで、ソートの要求が発生します。

スライドは、複数のPC上で作成するため、一つのファイルに集める時には、順番がバラバラです。
このとき、各スライドには日時が入力されているので、順番に並んでいないと気持ちが悪いんです。

でも、手で並べ直すと、かけた時間に比べて、得られるメリットが少ないので、時間の無駄でしかありません。

そこで、マクロを使ってソートさせることにしました。

PowerPointのマクロ

Excelのマクロはしょっちゅう使っています。でも、PowerPointのマクロを使うのは初めてです。

以下のように辿って、「開発」のチェックボックスにチェックを入れたら、「開発」タブが現れ、Visual Basicやマクロのアイコンが現れました。

ファイル → オプション → リボンのユーザー設定 → メインタブ → 開発

これで、「『マクロの記録』を使えば、サンプルのマクロが得られる」と思ったら・・・

マクロの記録ボタンがありません。
PowerPoint2019から廃止されたようです。

まぁ、ググればすぐにマクロのサンプルを調べることができるので困らないといえば困りませんが、困ります。

スライドをソートするマクロ

いろいろ調べて以下のようなコードを書いてみました。

「開発」タブを選択 →「Visual Basic」を選択 →「標準モジュール」を右クリック→「挿入」→「標準モジュール」を選択し、ここにコピー&ペーストすれば使えるようになります。

Option Explicit

'-----------------------------------------------------------------------
' Summary: 日時に従って昇順ソートする
'-----------------------------------------------------------------------
Public Sub Ascending()
    ' 昇順ソートを意味する定数の定義
    Const cstAscending As Boolean = True
    ' 昇順ソートを実施
    Call Sort(cstAscending)
End Sub

'-----------------------------------------------------------------------
' Summary: スライドが作成された日時を返す
' Input  : intSlide: スライド番号
' Returns: スライドが作成された日時
'-----------------------------------------------------------------------
Private Function DateTime(ByVal intSlide As Integer) As Date
    Dim shp As Shape    ' Shape
    
    ' 日時をクリア
    DateTime = 0
    ' Shapeを順に調べる
    For Each shp In ActivePresentation.Slides(intSlide).Shapes
        ' ピリオドの場合はスラッシュに変えつつ日付型であるか調べる
        If shp.Type = msoPlaceholder Then
            If IsDate(Replace(shp.TextFrame.TextRange.Text, ".", "/")) Then
                ' Date型の場合は変数に加算する
                DateTime = DateTime + CDate(Replace( _
                        shp.TextFrame.TextRange.Text, ".", "/"))
            End If
        End If
    Next shp
End Function

'-----------------------------------------------------------------------
' Summary: 日時に従って降順ソートする
'-----------------------------------------------------------------------
Public Sub Descending()
    ' 降順ソートを意味する定数の定義
    Const cstDescending As Boolean = False
    ' 降順ソートを実施
    Call Sort(cstDescending)
End Sub

'-----------------------------------------------------------------------
' Summary: スライドをソートする
' Input  : blnAscending: True → 昇順、False → 降順
'-----------------------------------------------------------------------
Private Sub Sort(ByVal blnAscending As Boolean)
    Const cstTime   As Long = 50
    Dim dteCurrent  As Date     ' 処理対象のスライドの日時
    Dim i           As Integer  ' ループカウンタ
    Dim intCurrent  As Integer  ' 処理対象のスライド番号
    Dim intSlideCnt As Integer  ' スライド総数
    Dim j           As Integer  ' ループカウンタ
    
    ' スライド数を取得
    intSlideCnt = ActivePresentation.Slides.Count
    ' 1枚以下なら何もしない
    If intSlideCnt <= 1 Then Exit Sub
    
    ' 高速化のため、昇順と降順で分ける
    If blnAscending Then
        ' 後ろから前に向かって調査する
        For i = intSlideCnt To 1 Step -1
            ' 範囲の最後のスライドを比較元スライドとする
            intCurrent = i
            ' 比較元スライドの日時文字列を変数に保持する
            dteCurrent = DateTime(intCurrent)
            ' 範囲の最後の一つ前から1番目のスライドまでを調査
            For j = i - 1 To 1 Step -1
                ' 調査対象スライドの日時文字列を取得し、比較元と比較
                If DateTime(j) < dteCurrent Then
                    ' 調査対象スライドの日時の方が古ければ比較元と交換
                    intCurrent = j
                    dteCurrent = DateTime(j)
                End If
            Next j
            ' 調査中のスライドのうち、一番古いスライドを一番後ろに持っていく
            ActivePresentation.Slides(intCurrent).MoveTo (intSlideCnt)
        Next i
    Else
        ' 不等号が逆なこと以外は昇順と同じ理屈で降順ソートする
        ' 後ろから前に向かって調査する
        For i = intSlideCnt To 1 Step -1
            ' 範囲の最後のスライドを比較元スライドとする
            intCurrent = i
            ' 比較元スライドの日時文字列を変数に保持する
            dteCurrent = DateTime(intCurrent)
            ' 範囲の最後の一つ前から1番目のスライドまでを調査
            For j = i - 1 To 1 Step -1
                ' 調査対象スライドの日時文字列を取得し、比較元と比較
                If DateTime(j) > dteCurrent Then
                    ' 調査対象スライドの日時の方が新しければ比較元と交換
                    intCurrent = j
                    dteCurrent = DateTime(j)
                End If
            Next j
            ' 調査中のスライドのうち、一番古いスライドを一番後ろに持っていく
            ActivePresentation.Slides(intCurrent).MoveTo (intSlideCnt)
        Next i
    End If
End Sub

マクロのアルゴリズム

個々のスライドに要求される条件としては、プレスホルダがあり、そのいずれかに日付や時刻の情報があることです。

スライドの例

スライドの例

例えば、この例では、左上に日付と時刻があります。

使い方は、「開発」タブ →「マクロ」を選択し、Ascending(昇順)又はDescending(降順)を選ぶだけです。
それぞれのサブルーチンは、それぞれの動作フラグを引数としてSort関数を呼び出します。

昇順の場合、Sort関数は、まず、最も日時の古いスライドを見つけ出して、それを一番最後に持ってきます。次に、残りのスライドを検索範囲として、次に古いスライドを見つけ出して、それを範囲の最後に持ってきます。以下、同様に、残りのスライドの中から最も古いスライドを後ろに持っていくことを繰り返すことにより、昇順にソートします。
降順は最も新しいスライドを最後に持ってきます。

DateTime関数は、Shape要素のうち、プレースホルダを順次探し、日付や時刻とみなせる要素がある場合には、その値を累積加算し、そのスライドの作成日時とします。日時情報が見つからない場合は、”1899/12/30 00:00:00”として扱います。

まとめ

このマクロを作ったことにより、スライドを容易に並べ直すことができるようになりました。110枚をソートするのに約5秒です。

生産性の乏しい作業に時間を取られなくなったので、満足しています。

コメント

タイトルとURLをコピーしました