[[20240508110924]]　『ExcelVBAでPowerPointのコメントを返信も含めてEx』（かき）　ページの最後に飛ぶ

『ExcelVBAでPowerPointのコメントを返信も含めてExcelに抽出したい』（かき）

はじめまして。Excel VBAでPowerPointのコメントを指定のExcelシートに抽出するマクロを組んでいるのですが、コメントの返信が上手く抽出できません。
具体的には、コメント内容をExcelのA1に、返信をB1抽出したく、
もし返信が複数ある場合はB1セルに改行してまとめて抽出したいです。

また、Powerpointコメントのスレッドが解決済みであれば、C1に「○」を入れたいと考えています。
PowerPointのコメントの解決済みに該当するExcelVBAのプロパティがあればご教示いただきたいです。
以上、ご存知の方いらっしゃいましたらよろしくお願いいたします。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

 ExcelではなくてPowerPointのVBAについての質問になってしまってますが
 今できているところまで、書いてください。

 ちなみにですが 返信は、CommnentオブジェクトのRepliesプロパティです
 この回答でわかりますかね？

 Sub sample()
    Dim sld As Slide
    Dim cmnt As Comment, repl As Comment
    For Each sld In ActivePresentation.Slides
        For Each cmnt In sld.Comments
            Debug.Print cmnt.Author; cmnt.Text
            For Each repl In cmnt.Replies
                Debug.Print repl.Author; repl.Text;
            Next
            Debug.Print
        Next
    Next
 End Sub
（´・ω・` ） 2024/05/08(水) 13:10:50

（´・ω・` ）様
ご返信いただきありがとうございます。
今回、Excelシート上にボタンを作り、それをクリックするとファイルダイアログが開き、選択したパワーポイントのコメントをExcelシート上に抽出するというマクロを組んでいます。

返信はCommentオブジェクトのRepliesプロパティであることは存じ上げておりまして、
返信自体は抽出はされるのですが、なぜかスレッドの1番最後の返信のみ抽出される状態です。
以下のコードでも試してみましたがエラーでした。
For Each ppReply In ppComment.Replies

     For i = 1 To ppComment.Replies.Conut
      destWorksheet.Cells(Rows.Count,3).End(xlUp).offset(1).value = ppReply(i).Text & vbLf
    Next = i
Next  ppReply

（かき） 2024/05/08(水) 16:22:55

 >スレッドの1番最後の返信のみ抽出
 ステップ実行して確認してみるとわかりますが、
 セルの値を毎回書き換えてるのでそうなります

 追記するにはこんな感じです。（未テストです）

    If ppComment.Replies.Conut > 0 Then
       repText=ppReply(1).Text
       For i = 2 To ppComment.Replies.Conut
          repText = repText & vbLf & ppReply(i).Text
       Next = i
       destWorksheet.Cells(Rows.Count,3).End(xlUp).offset(1).Value = repText
    End IF
（´・ω・` ） 2024/05/08(水) 16:49:59

    Sub sample()
      Dim pptApp As PowerPoint.Application
      Dim pptfn As Variant, ppt As PowerPoint.Presentation
      Dim sld As PowerPoint.Slide, cmnt As PowerPoint.Comment, repl As PowerPoint.Comment

      pptfn = Application.GetOpenFilename("PowerPointプレゼンテーション,*.pptx")
      If TypeName(pptfn) = "Boolean" Then Exit Sub

      Set pptApp = CreateObject("PowerPoint.Application")
      pptApp.Visible = True
      Set ppt = pptApp.Presentations.Open(pptfn, ReadOnly:=msoTrue)

      Dim r As Long
      r = 2
      For Each sld In ppt.Slides
          For Each cmnt In sld.Comments
              Cells(r, "A").Value = cmnt.Author & Space(1) & cmnt.Text
              For Each repl In cmnt.Replies
                  Cells(r, "B").Value = Cells(r, "B").Value & IIf(Cells(r, "B").Value = "", "", vbLf) & repl.Author & Space(1) & repl.Text
              Next
          Next
          r = r + 1
      Next

      ppt.Close
      pptApp.Quit

    End Sub
（´・ω・` ） 2024/05/08(水) 16:54:26

返信遅くなり申し訳ございません。
度々丁寧に教えていただきありがとうございます。
二つ目に送っていただいたコードで実行してみたところ、上手く抽出されました。
大変助かりました、ありがとうございます
（かき） 2024/05/09(木) 17:02:25

コメント返信：

[ 一覧(最新更新順) ]

[[20240508110924]] 『ExcelVBAでPowerPointのコメントを返信も含めてEx』（かき） ページの最後に飛ぶ

[[20240508110924]]　『ExcelVBAでPowerPointのコメントを返信も含めてEx』（かき）　ページの最後に飛ぶ