VBAでExcelからPowerPointに表の範囲を張り付ける際の文字サイズ

Question

Excel上の範囲をCopyメソッドでコピーし、PowerPointのシートにPasteSpecialメソッドで張り付けるという処理をすると、張り付け後、サイズが勝手に修正されてしまいます。

Dim ppApp As New PowerPoint.Application
Dim ppPrs As PowerPoint.Presentation
    
'パワーポイントを開く
Set ppPrs = ppApp.Presentations.Open("test.pptx") '

'エクセル上で指定範囲をコピー
ActiveSheet.Range("B2:G3").Copy

'パワーポイントに張り付け
ppPrs.Slides(1).Shapes.PasteSpecial DataType:=0

高さ、幅については、張り付け後、サイズ指定することで補正は出来るのですが、文字サイズだけはなぜかできません。

With ppPrs.Slides(1).Shapes(1)
    .Width    = 100 '幅
    .Height   = 200 '高さ
    .Top      = 100 '垂直位置
    .Left     = 100 '水平位置
    .FontSize = 10  '文字サイズ
End With

このように指定すると、幅、高さ、垂直位置、水位置は指定できるのですが、文字サイズは指定できません。

「オブジェクトは、このメソッドをサポートしていません。」

と表示されてしまいます。

PasteSpecialで張り付けたオブジェクトの文字サイズは変更させられないのでしょうか？
それとも、指定方法が間違っているのでしょうか？

Comments

[YT0014]

回答記載の為、削除

Answer 1

これで解決致しました。

Dim ppApp As New PowerPoint.Application
Dim ppPrs As PowerPoint.Presentation
Dim TargetTable As Table
Dim r As Row, c As Cell, tr As TextRange

'パワーポイントを開く
Set ppPrs = ppApp.Presentations.Open("test.pptx") '

'エクセル上で指定範囲をコピー
ActiveSheet.Range("B2:G34").Copy

'パワーポイントに張り付け
ppPrs.Slides(1).Shapes.PasteSpecial DataType:=0
    
Set TargetTable = ppPrs.Slides(1).Shapes(1).Table

For Each r In TargetTable.Rows

    For Each c In r.Cells

        c.Shape.TextFrame.TextRange.Font.Size = 10 ' ← ここで文字をセットする
            
    Next
        
    Next

Comments

[YT0014]

解決おめでとうございます。
セル毎にShapeになっていたとは。勉強になりました。ありがとうございました。

[KentarouOgura]

解決は解決ですが、セル単位での文字サイズ変更は無駄な気がするんですよね。。。
表単位で一気に文字サイズ変更できてもいいはずだと思ってしまうのですが。。。

Answer 2

Shapeオブジェクト

ShapeオブジェクトにはFontプロパティはありません。
TextEffectプロパティから、TextEffectFormatオブジェクトが取得でき、そちらでFontSizeなどを変更できるようにはなっていますが、表がTextFrameなどになっているとは考えづらく、こちらの方法でも変更できないかと思います。

貼付けの前か後かはともかくとして、Excelオブジェクトとして、Font調整をすることをお勧めします。

Comments

[KentarouOgura]

TY0014様
ご回答ありがとうございます。
Excelオブジェクトとして、ですか？
ちょっと調べてみます！