回答編集履歴

2

不要変数の削除

2020/09/16 00:47

投稿

radames1000
radames1000

スコア1925

test CHANGED
@@ -16,7 +16,7 @@
16
16
 
17
17
  Dim ppSld As Object 'PowerPointスライド
18
18
 
19
- Dim ppW As Single, ppH As Single, i As Integer
19
+ Dim i As Integer
20
20
 
21
21
 
22
22
 

1

追記

2020/09/16 00:47

投稿

radames1000
radames1000

スコア1925

test CHANGED
@@ -1,3 +1,97 @@
1
1
  コードを書く時間がないので参考URLだけ共有しますね。
2
2
 
3
3
  [https://teratail.com/questions/142599](https://teratail.com/questions/142599)
4
+
5
+
6
+
7
+ ---
8
+
9
+ ```VBA
10
+
11
+ Sub test()
12
+
13
+ Dim ppApp As Object 'PowerPointアプリ
14
+
15
+ Dim ppPst As Object 'PowerPointプレゼン
16
+
17
+ Dim ppSld As Object 'PowerPointスライド
18
+
19
+ Dim ppW As Single, ppH As Single, i As Integer
20
+
21
+
22
+
23
+ 'PowerPointを起動
24
+
25
+ Set ppApp = CreateObject("PowerPoint.Application")
26
+
27
+
28
+
29
+ 'PowerPointを表示
30
+
31
+ ppApp.Visible = msoTrue
32
+
33
+ 'PowerPoint新規プレゼンテーション作成
34
+
35
+ Set ppPst = ppApp.Presentations.Add(WithWindow:=True)
36
+
37
+
38
+
39
+ '最終行の取得
40
+
41
+ Dim myRow As Long
42
+
43
+ myRow = Cells(Rows.Count, 1).End(xlUp).Row
44
+
45
+
46
+
47
+ 'Excel各シートの貼り付け
48
+
49
+ For i = 2 To myRow
50
+
51
+ Range(Cells(i, 1), Cells(i, 4)).Copy
52
+
53
+ 'PowerPointスライド追加
54
+
55
+ Set ppSld = ppPst.Slides.Add(Index:=i - 1, Layout:=12)
56
+
57
+ ppPst.Slides(i - 1).Select
58
+
59
+
60
+
61
+ '貼り付け
62
+
63
+ ppApp.CommandBars.ExecuteMso "PasteAsEmbedded" '埋め込み
64
+
65
+ ' ppApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting" '元の書式
66
+
67
+
68
+
69
+ Next
70
+
71
+
72
+
73
+ End Sub
74
+
75
+ ```
76
+
77
+ ・埋め込みで貼り付ければ書式はそのままになります。ダブルクリックをすればExcelが開いて編集できます。
78
+
79
+ ・コメントアウトしていますが、元の書式で貼り付ければ書式や罫線がそのまま貼り付けられるはず、
80
+
81
+  なのですが、一行だけだと書式が反映されないようです。
82
+
83
+  二行以上だと書式も反映されるようですがこちらがお好みであれば色々修正してみてください。
84
+
85
+
86
+
87
+ こちらのコードはステップインで試せばうまくいくのですが、
88
+
89
+ そのまま実行してもうまくいかないと思います。
90
+
91
+ > ※ExecuteMsoは非同期実行なので、グラフ貼り付けが終わるまで待つ処理がポイントです。 
92
+
93
+
94
+
95
+ 待つ処理は参考URLやその先を見て、ご自身で調整してみてください。
96
+
97
+ 環境によっても異なると思いますので…