人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

EXCELVBAで既存パワーポイントを開き、セル値を取得してパワーポイントファイル名としたい
ソースは添付画像をご確認していただき、
元ネタ:http://ateitexe.com/excelvba/ppt-select-paste/

以下の項目ができるようにしたい。
・ファイルサーバー上にあるパワーポイント原本をコピー
・コピーしたパワーポイントにEXCELグラフを貼付け
・EXCELのセル値(B1)をパワーポイントファイル名にする
・パワーポイントファイルの保存先は、どのユーザーでもデスクップ上にしたい

以上、よろしくお願いします。

1359868148
●拡大する


●質問者: japan-nan
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● oil999
●300ポイント ベストアンサー

以下のマクロをお試しください。
質問にあったリンク先の通り、次の変数に値を設定しておく必要があります。

Option Explicit

Sub select_CopyToPPT()
 Dim ppApp As Object 'PowerPointアプリ
 Dim ppPst As Object 'PowerPointプレゼン
 Dim ppSld As Object 'PowerPointスライド
 Dim sheet As String
 Dim n As Integer, i As Integer, flg As Boolean
 Dim PecNmb As Integer, ShtNam As Variant, GrpNmb As Variant, SldNmb As Variant
 Dim sour As String, path As String, ppname As String

  'ファイル名のあるシート名
 sheet = "Sheet2"
  'サーバにあるPowerPointファイル
 sour = "\\Server\hoge\hoge.pptx"
  '処理したいExcelグラフの数
 PecNmb = 3
  'コピーしたいExcelグラフが存在するシート名
 ShtNam = Array("Sheet1", "Sheet2", "Sheet3")
  'コピーしたいExcelグラフの名前
 GrpNmb = Array("グラフ 1", "グラフ 2", "グラフ 3")
  '貼り付け先PowerPointのスライド番号
 SldNmb = Array(1, 2, 3)

 path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\"
 ppname = Worksheets(sheet).Range("B1").Value
 
 FileCopy sour, path & ppname
 Set ppApp = CreateObject("PowerPoint.Application")
 With ppApp
 .Visible = True
 .Presentations.Open Filename:=path & ppname, ReadOnly:=msoFalse
 End With
 Set ppPst = ppApp.ActivePresentation

 For n = 0 To PecNmb - 1
  '指定範囲をクリップボードにコピー
 Sheets(ShtNam(n)).ChartObjects(GrpNmb(n)).CopyPicture xlScreen, xlPicture
  'PowerPointスライド指定
 Set ppSld = ppPst.Slides(SldNmb(n))
  '貼り付け
 ppSld.Shapes.Paste
 Next n
 ppPst.Save
 ppPst.Close
 ppApp.Quit
End Sub

関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ