パワポでテキストボックス内のテキストを取得するマクロ備忘録

マクロ

ちょっとした理由があって、パワーポイントのファイルの中のテキストボックスに収まっているテキストを文字列として取得して、クリップボードにコピーするマクロを作ってみたので、特にクリップボード周りの処理について備忘録代わりにまとめてみる。

やること

やることは、
　1.スライドをそれぞれ順番に全てを調べる。
　2.それぞれのスライドの中にある全てのシェイプを調べる。
　3.シェイプの中にテキストがあれば、そのテキストを変数に収める。
　4.全てのテキストを改行でつなぎ一つの変数とする。
　5.その変数に納められたテキスト行をクリップボードにコピーする。
です。

スライド

まずは、全てのスライドを調べるのは以下の感じで全てのスライドを渡っていきます。

    Dim pSlide As Slide
    For Each pSlide In ActivePresentation.Slides
　　'ここに処理を記述
　　Next

シェイプ

次に、そのスライドの中にある全てのシェイプを調べます。

    Dim pShape As Shape
    For Each pShape In pSlide.Shapes
　　'ここに処理を記述
　　Next

テキスト

このシェイプの中にテキストが入っているかどうかを調べ、そして、もしあった場合には、それを変数（MergedText）の中に改行（vbCrLf）付きで加えていきます。

    If pShape.TextFrame.HasText Then
       MergedText = MergedText & pShape.TextFrame2.TextRange.Text & vbCrLf
    End If

クリップボード

上記を組み合わせて、一つの変数に全てのテキストを収めるようにします。
その変数は、クリップボードに納めます。
クリップボードに納めるために今回用いた手法では、Microsoft Forms 2.0 Object Library を使用します。使用するためには、参照設定で、このライブラリを選択します。もし、無ければ、"参照..."を押して、FM20.DLL を選びます。通常、"C:\Windows\system32\" の中にこれはあります。

クリップボードクリア

まず、クリップボードをクリアします。
これには、まず以下の宣言を記述します。

　　Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
　　Public Declare Function EmptyClipboard Lib "user32" () As Long
　　Public Declare Function CloseClipboard Lib "user32" () As Long

その上で、コードの中に、以下を記述します。

    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard

クリップボードへコピー

そのクリップボードへ変数（MergedText）の文字列をコピーするには以下のように記述します。

    Dim ClipBrd As New DataObject
    Dim buffer As String
    With ClipBrd
        .SetText MergedText
        .PutInClipboard
        .GetFromClipboard
        buffer = .GetText
    End With

合体

これで、全ての記述は終了。
最後に、メッセージボックスに完了の言葉を記述するコメントを出力するようにして起きます。
ということで上記を合体してできあがるものが下記です。

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Public Sub ReadTextsInTheBox()

    Dim pSlide As Slide
    Dim pShape As Shape
    Dim MergedText As String

    ' Check All Slides from the Top
    For Each pSlide In ActivePresentation.Slides
        ' Check All Slides in the Slide
        For Each pShape In pSlide.Shapes
            ' On each Slide, Check All Shapes with Text
            If pShape.TextFrame.HasText Then
                'Add All String in the Slide with Return
                MergedText = MergedText & pShape.TextFrame2.TextRange.Text & vbCrLf
            End If
        Next
        'Add Allstring in the Presentation with Return
        MergedText = MergedText & vbCrLf
    Next
        
    'Clear Clipboard
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard

    'Copy to Clipboard All String
    Dim ClipBrd As New DataObject
    Dim buffer As String
    With ClipBrd
        .SetText MergedText
        .PutInClipboard
        .GetFromClipboard
        buffer = .GetText
    End With
    MsgBox "クリップボードに全てのテキストをコピーしました。"
End Sub

これでうまくいくはず

ということで、これでうまくいくはず。
途中の処理はいろいろと変更すれば、いろいろとアレンジが出来るような気もします。
ちなみに、ここでは全てのシェイプを調べていますが、シェイプタイプによって調べるかどうかを判断するようにするには、以下のような記述を追加するといけるはずです。

　　If pShape.Type = msoTextBox Then
　　'ここに処理を記述
　　End If

なお、シェイプタイプは、以下などを参考にすると何がどのような記述かがわかります。

http://msdn.microsoft.com/ja-jp/library/microsoft.office.core.msoshapetype(v=office.11).aspx#Y200

Rogi073.Diary 2.0