ＶＢＡ超初心者です。

プログラミング超初心者です。
下のは、pptxのスライド１枚目に表示されているすべての文字・色・大きさを１文字ずつ取ってくるマクロです。
これを改造して、
(1)pptxファイル内のすべてのスライドに対して
(2)"文字　色　大きさ"の形式で
(3)結果をテキストファイルに書き出す（スライド１枚につきテキストファイル１つでも、全部まとめてテキストファイル１に書き出すでもＯＫ）（さらにシェイプ毎に分かれてくれたら尚嬉しい）
にはどうすればいいのでしょうか？
改造後のソースを書いてくれると助かります。注文の多い我儘な質問ではありますが、よろしくお願いします。
------------------------------------------------------------
Sub Sample1()
'1文字ずつ文字情報取得

Dim myShape As Shape
Dim myCharacter As Object

'スライド1のシェイプを処理
For Each myShape In ActivePresentation.Slides(1).Shapes
With myShape
'テキストがあるシェイプを処理
If .TextFrame.HasText Then
For Each myCharacter In .TextFrame.TextRange.Characters
MsgBox "テキスト：" & myCharacter.Text & vbCrLf & _
"フォントカラー：" & myCharacter.Font.Color & vbCrLf & _
"フォントサイズ：" & myCharacter.Font.Size
Next
End If
End With
Next
End Sub
--------------------------------------------------------------

No.1 ベストアンサー 回答者： temtecomai2 回答日時： 2008/12/20 12:07

たいしたテストもしてません。

現在のファイル全体で 1つのテキストファイルにしてます。
ファイルに書き出す技術は FileSystemObject を使っています。
お勉強なさると便利です。
http://www.google.com/search?hl=ja&lr=lang_ja&ie …
-------------------------------

Option Explicit

Dim fso As Object
Dim ts As Object

Sub AnalyzeSlide() ' これを実行
Dim mySlide As Slide
Dim myShape As Shape
Dim myCharacter As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile("d:\log.txt", 2, True)
' ↑↑↑↑ 適当なパスに変更

AppendText "ファイル名:" & ActivePresentation.Name

For Each mySlide In ActivePresentation.Slides
AppendText "----------------"
AppendText "スライド名: " & mySlide.Name

For Each myShape In mySlide.Shapes
AppendText "シェイプ名: " & myShape.Name
If myShape.TextFrame.HasText Then
For Each myCharacter In myShape.TextFrame.TextRange.Characters
AppendText vbTab & "テキスト: " & myCharacter.Text
AppendText vbTab & "フォント カラー: " & myCharacter.Font.Color
AppendText vbTab & "フォント サイズ: " & myCharacter.Font.Size
Next
End If
AppendText
Next
Next

ts.Close
Set ts = Nothing
Set fso = Nothing

End Sub

Private Sub AppendText(Optional aLineText As String = "")
ts.WriteLine aLineText
End Sub

この回答への補足

図形の中に文字があったらダメなようです。今頃気づきましたごめんなさい。

どうやったら図形の中の文字を取得できるのでしょうか？引き続きお願いします。

補足日時：2008/12/20 14:51

この回答へのお礼

おぉ！こんなにも早く回答していただいてありがとうございます！！！

いざパス名を変更して、今、試しているのですが、２４行目の
For Each myCharacter In myShape.TextFrame.TextRange.Characters
のところで、
実行時エラー'-2147024809(80070057)'
このメンバにアクセスできるのは、単一の図形の場合だけです。

となにかエラーっぽいものが出てしまいます。どうやったらうまくこのエラーを消せるのでしょうか？お願いします。

お礼日時：2008/12/20 14:33