質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.64%

エクセルからパワーポイントのテキストコメントと設定を取得したい

解決済

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 2,412

OMUSUBI

score 11

エクセルからパワーポイントファイルの
テキストボックスの文章・余白・左寄せなどをリスト化したいと思っています。
エクセルとパワーポイントは2002を使用しています。

c:\testフォルダに入っているパワーポイントファイルを開き、
A1~J1のセルに
パワーポイントのテキストボックスのコメントや
左寄せ右寄せなどの設置値(1や2など)
余白の自動設定の有無(trueやfalseなど)
余白の上下左右値を取得したいです。(数値)

現在のコードでは余白の抽出や左寄せの部分で
エラーになりうまく動きません。

すみませんが教えて下さい。

コード
' // フォルダ内の *.ppt ファイルからテキストを抽出する
Sub OutputText()

    Dim ppApp   As Object ' // PowerPoint.Application
    Dim ppPre   As Object ' // PowerPoint.Presentation
    Dim ppShp   As Object ' // PowerPoint.Shape
    Dim ppSld   As Object ' // PowerPoint.Slide
    Dim sPath   As String
    Dim sFnam   As String
    Dim i       As Long
    Dim sh      As Worksheet

    ' // 処理対象のフォルダパス
    sPath = "C:\test\"

    ' // 初回ファイル検索
    sFnam = Dir$(sPath & "\" & "*.ppt")
    If Len(sFnam) = 0 Then
        MsgBox "*.ppt が見つかりません", vbInformation
        Exit Sub
    End If

    On Error GoTo Err_

    ' // PowerPoint起動
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
    ' // 出力シート作成
    Set sh = Workbooks.Add.Sheets(1)
    With sh.Range("A1:J1")
        .Font.Bold = True
        .Value = Array("Filename", "Slide Number", "Shape Name", "Text", "Alignment", "AutoMargins", "MLeft", "MTop", "MRight", "MBottom")
    End With

    ' // リスト開始行番号
    i = 2
    ' // *.ppt が見つからなくなるまでループ
    Application.ScreenUpdating = False
    While Len(sFnam) > 0
        ' // Presentation を開き、全ての Slide -その中の全ての Shape について
        ' // テキストがあればセルに出力する
        Set ppPre = ppApp.Presentations.Open(Filename:=sPath & "\" & sFnam, _
                                             ReadOnly:=True)
        For Each ppSld In ppPre.Slides
           For Each ppShp In ppSld.Shapes
               If ppShp.HasTextFrame Then
                 sh.Cells(i, "A").Value = sFnam
                 sh.Cells(i, "B").Value = ppSld.SlideNumber
                 sh.Cells(i, "C").Value = ppShp.Name
                 sh.Cells(i, "D").Value = Replace$(ppShp.TextFrame.TextRange.Text, _
                                                      vbCr, vbLf)
                 sh.Cells(i, "E").Value = ppShp.TextFrame.ParagraphFormat.Alignment '//寄せ位置を数字で表示したい
                 sh.Cells(i, "F").Value = ppShp.TextFrame.AutoMargins               '//自動チェックのfalseかtrueを表示したい
                 sh.Cells(i, "G").Value = ppShp.TextFrame.MarginLeft                '//余白左側の数値
                 sh.Cells(i, "H").Value = ppShp.TextFrame.MarginTop                 '//余白上側の数値
                 sh.Cells(i, "I").Value = ppShp.TextFrame.MarginRight               '//余白右側の数値
                 sh.Cells(i, "J").Value = ppShp.TextFrame.MarginBottom              '//余白下側の数値

                    i = i + 1
                End If
            Next
        Next
        ' // Presentation を閉じ、次のファイルを検索
        ppPre.Close
        Set ppPre = Nothing
        sFnam = Dir$()
    Wend
    ppApp.Quit
    sh.Columns.AutoFit
    sh.Rows.AutoFit

Bye_:
    Set ppApp = Nothing
    Set sh = Nothing
    Exit Sub
Err_:
    MsgBox Err.Description, vbCritical
    Resume Bye_
End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

0

はじめまして、thom.jpです。

手元のバージョンが2010なので、断言はできませんが、、
ParagraphFormatはTextFrame.TextRangeのプロパティかと思われますので、飛ばして書けないと思います。
ExcelのShape.TextFrameにはAutoMarginsがありますが、PowerPointには無いように思えます。

VBEからPowerPointを参照設定すると、オブジェクトブラウザでパワポのシェイプについて確認できますが、そちらで確認したところ、TextFrameにAutoMarginsプロパティは無いですね。

Excel、PowerPoint、Wordのシェイプはそれぞれ微妙に定義の異なるオブジェクトなので、代替手段が無さそうなら諦めるしかなさそうです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/01/03 22:49

    thom.jpさん
    返答ありがとうございます。

    余白のプロパティーをなんとかできないのか思っていたのですが、
    パワーポイントにはAutomaraginsプロパティーは無いのですね。
    エクセルに貼り付けた時にレイアウトが崩れるのは
    それが原因なのかなと思いました。
    アドバイス頂いた様に
    代替手段を考えてみて諦めるかどうかしたいと思います。
    ありがとうございました。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.64%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる