Results of 1 - 1 of about 3689 for グラフ (0.002 sec.)
- [[20240428172444]]
- #score: 3271
- @digest: 214c66a94ce575bbd07b86b939446ce9
- @id: 96672
- @mdate: 2024-04-29T11:29:05Z
- @size: 16607
- @type: text/plain
- #keywords: ppshape (232396), ppslide (211991), pppres (122854), 元ex (121748), 置縦 (85674), 置横 (83024), ppapp (82759), ズ横 (78761), ズ縦 (77045), 縦* (73808), 横as (70053), 横* (70053), 縦as (62350), 記¥ (57707), 新ペ (56707), フ貼 (52492), excelpath (51665), excelsheetname (51665), pptpath (47049), powerpoint (43344), 定ws (43127), ppt (36902), 名). (19922), ーポ (18758), スas (14774), 記( (14491), 得se (11890), msofalse (11371), パワ (11199), 名as (10411), ラフ (9696), グラ (8715)
- 『ExcelグラフのPPT貼付けマクロ 汎用性あるコードに改修したい』（ぷりん）
表題の件、アドバイスお願いします。 Excelのグラフ(オブジェクト名は「グラフ2」）をPPTの指定ページに貼り付ける工程を自動化したいです。 1.のコードは、マクロコードを記載しているファイルの「設定」シートに、 貼付け元のExcel_パス、Excel_シート名、PPT_パス、PPT更新ページ、グラフ貼付け時の位置縦 (cm)、位置横 (cm)、サイズ縦 (cm)、サイズ横 (cm)、グラフのオブジェクト名を書き込んで（B3セル〜B11セルまで）、そのセルを参照してグラフ転記を行ったものになります。 これで正しく動いています。 今回やりたいのは、Excelのセル上に必要情報を記載するのではなく、マクロのコード内にCallの引数としてこれら条件を設定したいです。 （1. のやり方でいいのかもしれませんが、汎用できるコードの書き方の勉強中のため、色々やり方を模索しています） そこで、2.を作ってみたのですが、これだとExcelパスやシート名、PPTパスがコードのどこに書いてあるか分かりづらいため、 3.を作ってみました。 一応、1, 2, 3どれも思い通りの結果にはなりますが、 どのように書けば使いまわしのきくものになるのか知りたいです。 引数等を使った経験がなく、使い方や使いどころがいまいち分かっていないため、ご教授いただきたく投稿しました。 1, 2, 3に関わらず、他にもシンプルなコードの書き方がありましたらアドバイスいただけますと嬉しいです。 <1のコード＞ Sub ExcelグラフのPPT転記() Dim 設定ws As Worksheet Dim Excel_パス As String Dim Excel_シート名 As String Dim PPT_パス As String Dim 元Excel As Worksheet Dim ppApp As Object Dim ppPres As Object Dim ppSlide As PowerPoint.Slide Dim ppShape As PowerPoint.Shape Dim 更新ページ As Long Dim 位置縦 As Double Dim 位置横 As Double Dim サイズ縦 As Double Dim サイズ横 As Double Dim オブジェクト名 As String Application.ScreenUpdating = False '画面の更新の停止 Set 設定ws = ThisWorkbook.Worksheets("設定") '元Excelファイルを開く Excel_パス = 設定ws.Range("B3").Value Excel_シート名 = 設定ws.Range("B4").Value Set 元Excel = Workbooks.Open(Excel_パス).Worksheets(Excel_シート名) '更新先パワーポイントを開く PPT_パス = 設定ws.Range("B5").Value 更新ページ = 設定ws.Range("B6").Value Set ppApp = CreateObject("powerpoint.application") Set ppPres = ppApp.Presentations.Open(PPT_パス) Set ppSlide = ppPres.Slides(更新ページ) 'グラフの貼付け位置とサイズを設定 位置縦 = 設定ws.Range("B7").Value 位置横 = 設定ws.Range("B8").Value サイズ縦 = 設定ws.Range("B9").Value サイズ横 = 設定ws.Range("B10").Value 'グラフのオブジェクト名を設定 オブジェクト名 = 設定ws.Range("B11").Value 'パワーポイントに前回貼付けのグラフが残っていたら削除 On Error Resume Next ppSlide.Shapes(オブジェクト名).Delete On Error GoTo 0 'ExcelのグラフをPPTに貼付け 元Excel.ChartObjects(オブジェクト名).Copy ppSlide.Shapes.PasteSpecial DataType:=ppPasteShape, Link:=msoFalse '表示スライドに貼り付けたグラフオブジェクトを再取得 Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) 'グラフサイズ・位置変更 'PowerPointマクロ上での長さ（pixel）とcmを換算 ((cmでの長さ) × 72 / 2.54) ppShape.LockAspectRatio = msoFalse 'アスペクト比を固定しない ppShape.Top = 位置縦 * 72 / 2.54 ppShape.Left = 位置横 * 72 / 2.54 ppShape.Height = サイズ縦 * 72 / 2.54 ppShape.Width = サイズ横 * 72 / 2.54 'Excelファイルは保存しないで閉じる 元Excel.Parent.Close savechanges:=False Application.ScreenUpdating = True '画面の更新の再開 'パワーポイントを保存して閉じる ppPres.Save ppPres.Close ' プレゼンテーションを閉じる ppApp.Quit ' PowerPoint アプリケーションを終了する 'オブジェクトを解放する Set ppShape = Nothing Set ppSlide = Nothing Set ppPres = Nothing Set ppApp = Nothing End Sub <2のコード＞ Sub グラフ貼付け() Call ExcelグラフのPPT転記(2, 2.55, 7.65, 8.25, 16.55, "グラフ2") End Sub Sub ExcelグラフのPPT転記(更新ページ As Long, 位置縦 As Double, 位置横 As Double, サイズ縦 As Double, サイズ横 As Double, オブジェクト名 As String) Dim Excel_パス As String Dim Excel_シート名 As String Dim PPT_パス As String Dim 元Excel As Worksheet Dim ppApp As Object Dim ppPres As Object Dim ppSlide As PowerPoint.Slide Dim ppShape As PowerPoint.Shape Application.ScreenUpdating = False '画面の更新の停止 '元Excelファイルを開く Excel_パス = "C:¥Users¥user¥Desktop¥諸々¥PPT転記¥Excel.xlsx" Excel_シート名 = "Sheet1" Set 元Excel = Workbooks.Open(Excel_パス).Worksheets(Excel_シート名) '更新先パワーポイントを開く PPT_パス = "C:¥Users¥user¥Desktop¥諸々¥PPT転記¥PPT.pptx" Set ppApp = CreateObject("powerpoint.application") Set ppPres = ppApp.Presentations.Open(PPT_パス) Set ppSlide = ppPres.Slides(更新ページ) 'パワーポイントに前回貼付けのグラフが残っていたら削除 On Error Resume Next ppSlide.Shapes(オブジェクト名).Delete On Error GoTo 0 'ExcelのグラフをPPTに貼付け 元Excel.ChartObjects(オブジェクト名).Copy ppSlide.Shapes.PasteSpecial DataType:=ppPasteShape, Link:=msoFalse '表示スライドに貼り付けたグラフオブジェクトを再取得 Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) 'グラフサイズ・位置変更 'PowerPointマクロ上での長さ（pixel）とcmを換算 ((cmでの長さ) × 72 / 2.54) ppShape.LockAspectRatio = msoFalse 'アスペクト比を固定しない ppShape.Top = 位置縦 * 72 / 2.54 ppShape.Left = 位置横 * 72 / 2.54 ppShape.Height = サイズ縦 * 72 / 2.54 ppShape.Width = サイズ横 * 72 / 2.54 'Excelファイルは保存しないで閉じる 元Excel.Parent.Close savechanges:=False Application.ScreenUpdating = True '画面の更新の再開 'パワーポイントを保存して閉じる ppPres.Save ppPres.Close ' プレゼンテーションを閉じる ppApp.Quit ' PowerPoint アプリケーションを終了する 'オブジェクトを解放する Set ppShape = Nothing Set ppSlide = Nothing Set ppPres = Nothing Set ppApp = Nothing End Sub <3のコード＞ Sub ExcelグラフのPPT貼付け() Dim ExcelPath As String Dim ExcelSheetName As String Dim PPTPath As String ' Excelファイルのパス、シート名、PPTファイルのパスを指定 ExcelPath = "C:¥Users¥user¥Desktop¥諸々¥PPT転記¥Excel.xlsx" ExcelSheetName = "Sheet1" PPTPath = "C:¥Users¥user¥Desktop¥諸々¥PPT転記¥PPT.pptx" Call ExcelグラフのPPT転記(ExcelPath, ExcelSheetName, PPTPath, 2, 2.55, 7.65, 8.25, 16.55, "グラフ2") End Sub Sub ExcelグラフのPPT転記(ExcelPath As String, ExcelSheetName As String, PPTPath As String, 更新ページ As Long, 位置縦 As Double, 位置横 As Double, サイズ縦 As Double, サイズ横 As Double, オブジェクト名 As String) Dim 元Excel As Worksheet Dim ppApp As Object Dim ppPres As Object Dim ppSlide As PowerPoint.Slide Dim ppShape As PowerPoint.Shape Application.ScreenUpdating = False '画面の更新の停止 '元Excelファイルを開く Set 元Excel = Workbooks.Open(ExcelPath).Worksheets(ExcelSheetName) '更新先パワーポイントを開く Set ppApp = CreateObject("powerpoint.application") Set ppPres = ppApp.Presentations.Open(PPTPath) Set ppSlide = ppPres.Slides(更新ページ) 'パワーポイントに前回貼付けのグラフが残っていたら削除 On Error Resume Next ppSlide.Shapes(オブジェクト名).Delete On Error GoTo 0 'ExcelのグラフをPPTに貼付け 元Excel.ChartObjects(オブジェクト名).Copy ppSlide.Shapes.PasteSpecial DataType:=ppPasteShape, Link:=msoFalse '表示スライドに貼り付けたグラフオブジェクトを再取得 Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) 'グラフサイズ・位置変更 'PowerPointマクロ上での長さ（pixel）とcmを換算 ((cmでの長さ) × 72 / 2.54) ppShape.LockAspectRatio = msoFalse 'アスペクト比を固定しない ppShape.Top = 位置縦 * 72 / 2.54 ppShape.Left = 位置横 * 72 / 2.54 ppShape.Height = サイズ縦 * 72 / 2.54 ppShape.Width = サイズ横 * 72 / 2.54 'Excelファイルは保存しないで閉じる 元Excel.Parent.Close savechanges:=False Application.ScreenUpdating = True '画面の更新の再開 'パワーポイントを保存して閉じる ppPres.Save ppPres.Close ' プレゼンテーションを閉じる ppApp.Quit ' PowerPoint アプリケーションを終了する 'オブジェクトを解放する Set ppShape = Nothing Set ppSlide = Nothing Set ppPres = Nothing Set ppApp = Nothing End Sub ＜ 使用 Excel:Microsoft365、使用 OS:Windows10 ＞ ---- グラフは一つではなく、複数あるわけですよね。 汎用性があるかどうか不明ですが、私ならデータはシートに書きます。 ・データは横一行に作成します。 ・グラフを指定するfunction procedureは、"行"番号だけ指定する方式にします。 （セル参照はCells(r,c)方式にします。） （縦書きのほうが慣れているなら、"列"でも問題ありませんが） こんな考え方もあるんじゃないでしょうか。一つの意見として参考に。 なお、シートは汎用の記憶場所ですから、なんらかのエラーに対する障害耐性もあります。 マイクロソフトは堅牢な変数として、シートに保持することを薦めています。 （xyz） 2024/04/29(月) 07:49:59 ---- xyz様 大変貴重なアドバイス、ありがとうございます。 はい、実際はグラフは複数あるものに対応させたいです。 例えば、<3のコード＞で、Callを2行にして Call ExcelグラフのPPT転記(ExcelPath, ExcelSheetName, PPTPath, 2, 2.55, 7.65, 8.25, 16.55, "グラフ2") Call ExcelグラフのPPT転記(ExcelPath, ExcelSheetName, PPTPath, 3, 5.55, 8.65, 7.25, 10.55, "グラフ1") のようにしても、動きましたが、これだとパワポをその都度開いて処理して、閉じて、また次のCallへ…となってしまう事にコメント頂いて気づきました。。（Excelのパスやシートも1つしか書けないので、やはりシートに記載した方が良いですね。 function procedureは、"行"番号だけ指定する方式とは、具体的にどのようなコードになりますか? （ぷりん） 2024/04/29(月) 09:36:01 ---- 呼ぶ側は行だけを引数にして、呼ばれた側でそれをもとにシートにアクセスするという意味でした。 もし不明でしたら却下ください。 （xyz） 2024/04/29(月) 10:20:13 ---- xyz様、ありがとうございます。理解しました。 確かに、Excelのセルに条件を書き出して、対応する行をCallで呼んだ方がシンプルで汎用性ききそうですね。 それを分かった上で恐縮ですが、朝の自分のやり方でどうしてもやってみたい事が実現できずアドバイス頂きたく、分かる方いらっしゃいましたら教えてください。 全体の構成を整理しなおしてみました。 下記のようにしたいのですが、どのように引数に設定したりファイル間の引き渡しをすればよいのか分からず、苦戦しています。 sub グラフ貼付け パワーポイントを開く Excelを開く Callで引数を設定して処理（引数に設定したいのは→ Excelのシート名,更新ページ,位置縦,位置横,サイズ縦,サイズ横,オブジェクト名) ※貼付けたいグラフがPPTの複数ページに渡る場合は、Callをその数分書く。 Excelを閉じる PPTを保存して閉じる オブジェクトの解放 End sub Function PPTグラフ貼付け処理( 〜 引数設定〜 ） 処理:Excelのシートを指定して、そのシートの指定オブジェクト名のグラフを、指定したPPTのページへ貼り付ける(ただし同じオブジェクト名が元からあった場合は元のを消す、グラフの位置やサイズの調整実施 End Function 下記に近いのかと思いますが、下記だと、Callで呼ぶたびにファイルを開いて閉じて…の処理が入ってしまうのと、あとは元のグラフが貼ってあるExcelのシートも複数シートに分かれる場合が想定されるため、シート名もCallの引数に渡したいです。 よろしくお願いします。 Sub グラフ貼付け() Call ExcelグラフのPPT転記(2, 2.55, 7.65, 8.25, 16.55, "グラフ2") Call ExcelグラフのPPT転記(3, 3.55, 8.65, 7.25, 10.55, "グラフ3") End Sub Sub ExcelグラフのPPT転記(更新ページ As Long, 位置縦 As Double, 位置横 As Double, サイズ縦 As Double, サイズ横 As Double, オブジェクト名 As String) Dim Excel_パス As String Dim Excel_シート名 As String Dim PPT_パス As String Dim 元Excel As Worksheet Dim ppApp As Object Dim ppPres As Object Dim ppSlide As PowerPoint.Slide Dim ppShape As PowerPoint.Shape Application.ScreenUpdating = False '画面の更新の停止 '元Excelファイルを開く Excel_パス = "C:¥Users¥user¥Desktop¥諸々¥PPT転記¥Excel.xlsx" Excel_シート名 = "Sheet1" Set 元Excel = Workbooks.Open(Excel_パス).Worksheets(Excel_シート名) '更新先パワーポイントを開く PPT_パス = "C:¥Users¥user¥Desktop¥諸々¥PPT転記¥PPT.pptx" Set ppApp = CreateObject("powerpoint.application") Set ppPres = ppApp.Presentations.Open(PPT_パス) Set ppSlide = ppPres.Slides(更新ページ) 'パワーポイントに前回貼付けのグラフが残っていたら削除 On Error Resume Next ppSlide.Shapes(オブジェクト名).Delete On Error GoTo 0 'ExcelのグラフをPPTに貼付け 元Excel.ChartObjects(オブジェクト名).Copy ppSlide.Shapes.PasteSpecial DataType:=ppPasteShape, Link:=msoFalse '表示スライドに貼り付けたグラフオブジェクトを再取得 Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) 'グラフサイズ・位置変更 'PowerPointマクロ上での長さ（pixel）とcmを換算 ((cmでの長さ) × 72 / 2.54) ppShape.LockAspectRatio = msoFalse 'アスペクト比を固定しない ppShape.Top = 位置縦 * 72 / 2.54 ppShape.Left = 位置横 * 72 / 2.54 ppShape.Height = サイズ縦 * 72 / 2.54 ppShape.Width = サイズ横 * 72 / 2.54 'Excelファイルは保存しないで閉じる 元Excel.Parent.Close SaveChanges:=False Application.ScreenUpdating = True '画面の更新の再開 'パワーポイントを保存して閉じる ppPres.Save ppPres.Close ' プレゼンテーションを閉じる ppApp.Quit ' PowerPoint アプリケーションを終了する 'オブジェクトを解放する Set ppShape = Nothing Set ppSlide = Nothing Set ppPres = Nothing Set ppApp = Nothing End Sub （ぷりん） 2024/04/29(月) 18:09:01 ---- 先ほどご質問させていただいた件、一応できました。 一般的な書き方がよく分かっていませんが、アドバイス等ありましたら引き続きご教授いただけますと幸いです。 xyz様からアドバイス頂きました方法も、並行して挑戦してみたいと思います。 Sub グラフ貼付け() Dim Excel_パス As String Dim PPT_パス As String Dim wb As Workbook Dim ppApp As Object ' Excel ファイルと PowerPoint ファイルのパスを指定 Excel_パス = "C:¥Users¥user¥Desktop¥諸々¥PPT転記¥Excel.xlsx" PPT_パス = "C:¥Users¥user¥Desktop¥諸々¥PPT転記¥PPT.pptx" ' Excel ファイルと PowerPoint アプリケーションを開く Set wb = Workbooks.Open(Excel_パス) Set ppApp = CreateObject("PowerPoint.Application") ppApp.Visible = True ppApp.Presentations.Open PPT_パス ' グラフを貼り付ける処理を呼び出す Call PPTグラフ貼付け処理(wb, "Sheet1", 2, 2.55, 7.65, 8.25, 16.55, "グラフ2") Call PPTグラフ貼付け処理(wb, "Sheet2", 3, 3.55, 8.65, 7.25, 10.55, "グラフ1") ' Excel ファイルを閉じる wb.Close SaveChanges:=False ' PowerPoint アプリケーションを終了する ppApp.ActivePresentation.Save ppApp.ActivePresentation.Close ppApp.Quit ' Excel と PowerPoint のオブジェクトを解放 Set ppApp = Nothing Set objExcel = Nothing End Sub Function PPTグラフ貼付け処理(Excel_シート名 As String, _ 更新ページ As Long, 位置縦 As Double, _ 位置横 As Double, サイズ縦 As Double, _ サイズ横 As Double, オブジェクト名 As String) Dim 元Excel As Worksheet Dim ppApp As Object Dim ppSlide As Object Dim ppShape As Object ' Excel ファイルから指定されたシートを取得 Set 元Excel = wb.Sheets(Excel_シート名) ' PowerPoint アプリケーションを取得 Set ppApp = GetObject(, "PowerPoint.Application") ' PowerPoint の指定ページを取得 Set ppSlide = ppApp.ActivePresentation.Slides(更新ページ) ' パワーポイントに前回貼付けのグラフが残っていたら削除 On Error Resume Next ppSlide.Shapes(オブジェクト名).Delete On Error GoTo 0 ' Excel のグラフを PPT に貼付け 元Excel.ChartObjects(オブジェクト名).Copy ppSlide.Shapes.PasteSpecial DataType:=ppPasteShape, Link:=msoFalse ' 貼り付けたグラフオブジェクトを再取得 Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) ' グラフサイズ・位置変更 ppShape.LockAspectRatio = msoFalse ppShape.Top = 位置縦 * 72 / 2.54 ppShape.Left = 位置横 * 72 / 2.54 ppShape.Height = サイズ縦 * 72 / 2.54 ppShape.Width = サイズ横 * 72 / 2.54 End Function （ぷりん） 2024/04/29(月) 20:29:05... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202404/20240428172444.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97045 documents and 608224 words.
訪問者：