| |
グラフと表をPPTに貼り付けたいのですが、グラフは貼り付けられるのですが
表が貼り付けられずエラーになります。
Sub Prop(New_Name As String, New_GrpFlg As Boolean, New_SldNmb As Integer, _
New_Top As Single, New_Left As Single, New_Width As Single, New_Height As Single, New_Odr As Integer)
'インスタンス生成
With New Class1
.Name = New_Name 'オブジェクト名
.GrpFlg = New_GrpFlg '図表フラグ
.SldNmb = New_SldNmb 'スライド番号
.Top = New_Top '上からの位置
.Left = New_Left '左からの位置
.Width = New_Width '横幅
.Height = New_Height '横幅
.Odr = New_Odr '順番
Objs.Add .Self 'Objsコレクションに追加
End With
End Sub
Call Prop("グラフ 12", True, 18, 4.53 * 28.35, 0.56 * 28.35, 11.3 * 28.35, 10.02 * 28.35, 0)
Call Prop("グラフ 13", True, 19, 3.63 * 28.35, 28.35, 23.6 * 28.35, 12.23 * 28.35, 0)
Call Prop("グラフ 14", True, 22, 3.23 * 28.35, 0, 15.23 * 28.35, 15.82 * 23.85, 0)
Call Prop("テーブル3", False, 14, 3.65 * 28.35, 13.03 * 28.35, 11.47 * 28.35, 11.54 * 28.35, 0)
Call Prop("deta2", False, 16, 3.65 * 28.35, 13.03 * 28.35, 11.47 * 28.35, 8.2 * 28.35, 0)
Call Prop("AI17:AL20", False, 18, 3.65 * 28.35, 13.03 * 28.35, 11.48 * 28.35, 4.86 * 28.35, 0)
On Error GoTo ERROR_HANDLER
Set ppApp = CreateObject("PowerPoint.Application")
Set ppPst = ppApp.ActivePresentation
Dim Obj As Class1
For Each Obj In Objs
'指定範囲をクリップボードにコピー
If Obj.GrpFlg = True Then
'グラフの場合
ThisWorkbook.Sheets(ShtNam).ChartObjects(Obj.Name).Copy
Else
'表の場合
ThisWorkbook.Sheets(ShtNam).ChartObjects(Obj.Name).CopyPicture xlScreen, xlPicture
End If
'PowerPointスライド指定
Set ppSld = ppPst.Slides(Obj.SldNmb)
'貼り付け
ppSld.Shapes.Paste
テーブル名、名前の定義、範囲選択と試したのですが
いずれも、『指定した名前のアイテムが見つかりませんでした。』とエラーになります。
表の場合、どのように書けば取れますでしょうか？
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
