Results of 1 - 1 of about 14741 for VBA�������������� (0.003 sec.)
- [[20190716230051]]
- #score: 3407
- @digest: 03e60a77d3a179930f90d094aeadb8cf
- @id: 80224
- @mdate: 2019-07-19T13:50:11Z
- @size: 10644
- @type: text/plain
- #keywords: pppst (111293), foundtext (66427), ppapp (41379), txtrng (33166), 幅. (31760), powerpoint (24768), slides (24724), sld (22785), findwhat (21322), 置. (20907), hastextframe (19899), activepresentation (16854), スラ (16708), 比固 (15951), appearance (15943), イド (15317), xlpicture (14778), xlscreen (14325), textrange (12217), 動en (10572), copypicture (9822), フ1 (7564), ド番 (5627), 語句 (5154), lockaspectratio (4969), chartobjects (4620), shapes (4400), ライ (4056), 定. (3996), shp (2425), パワ (2239), ーワ (2120)
- 『EXCEL VBAでパワポ内を検索したい』（もひ）
質問失礼いたします。 Excelでグラフを作成し、 Powerpointの特定の文字列があるスライドに 貼りつける仕組みを作りたいと思っています。 しかしExcel VBAとパワポの連携は事例も少なく、 連日色々と試してみたもののまったく実現できませんでした。 お力を貸していただきたく、どうぞよろしくお願いいたします。 Sub スライドを選択して図を貼りつけ() Dim ppApp As Object Dim ppPst As Object Set ppApp = CreateObject("PowerPoint.Application") Set ppPst = ppApp.ActivePresentation '--------データを図としてコピー ChartObjects("グラフ 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture '--------パワポ内でA1セルの語句を検索 '-------- スライド番号を取得 したい ppPst.Find (Range("A1").Value).Select i = ppPst.SlideRange.SlideIndex ppPst.Paste End Sub ＜ 使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- これってExcelというよりもPowerPointのVBAの質問のように思いますが、 勉強がてらやってみたら、以下でできました。グラフも検索文字も固定で適当です。 Sub Macro1() Dim ppApp As Object Dim ppPst As Object Set ppApp = CreateObject("PowerPoint.Application") Set ppPst = ppApp.ActivePresentation ThisWorkbook.Sheets(1).ChartObjects("グラフ 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture For Each sld In ppPst.Slides For Each shp In sld.Shapes If shp.HasTextFrame Then Set txtRng = shp.TextFrame.TextRange Set foundText = txtRng.Find(FindWhat:="あああ") Do While Not (foundText Is Nothing) With foundText sld.Shapes.Paste Exit Do End With Loop End If Next Next Set ppPst = Nothing Set ppApp = Nothing End Sub ちなみに、ExcelのグラフをPowerPointに貼りつける部分は以下のサイトを参考にしました。 簡単!エクセルVBAでシート上のグラフをコピーしてPowerPointにペーストする https://tonari-it.com/excel-vba-powerpoint-chat-copy-paste/ ※Googleでキーワード「vba excelのグラフをpowerpointに貼り付け」で1番上に出てきました。 PowerPointで語句を検索する部分は以下を参考にしました。 TextRange メソッド (PowerPoint) | Microsoft Docs https://docs.microsoft.com/ja-jp/office/vba/api/powerpoint.textrange.find ※Googleでキーワード「powerpoint vba 文字 検索」で出てきました。 私も勉強がてらやってみただけなのでこれ以上は分かりません。 上記のキーワードで検索するといろいろと情報が出てくるのは? （う） 2019/07/18(木) 10:09 ---- あっ、 さっきのサンプルだと1つのスライドに複数のShapesがあり、 検索文字がそれぞれのShapesにあると同じグラフが何度も張り付いてしまうので、 フラグ変数とか使って、1つのスライドで1回しか張り付かないように制御を追加する必要がありますね。 ご注意を。 （う） 2019/07/18(木) 10:19 ---- ん?もう一つ気づいた。何度もすみません。 そもそもDo While Not (foundText Is Nothing)でループする必要はなく、 IFで判定だけで良かったですね。 「見つかった文字を太字にする」サンプルを利用したので、余計な動きになっていました。 そうすると、前にコメントしたフラグもいらないので、こんな感じかな。 Sub Macro1() Dim ppApp As Object Dim ppPst As Object Set ppApp = CreateObject("PowerPoint.Application") Set ppPst = ppApp.ActivePresentation ThisWorkbook.Sheets(1).ChartObjects("グラフ 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture For Each sld In ppPst.Slides For Each shp In sld.Shapes If shp.HasTextFrame Then Set txtRng = shp.TextFrame.TextRange Set foundText = txtRng.Find(FindWhat:="あああ") If Not (foundText Is Nothing) Then sld.Shapes.Paste Exit For End If End If Next Next Set ppPst = Nothing Set ppApp = Nothing End Sub 一応、1スライドに1つしかペーストされないことは確認済み。 すでに張り付いているかどうかのチェックはしていません。 また、参考にしたサンプルが「完全に一致する単語をすべて検索」だったので、上記も完全一致です。 （う） 2019/07/18(木) 10:40 ---- う 様 ご回答いただきましてありがとうございます!! 自力では絶対に辿り着けないコードでした…… こんなにも丁寧に、参考サイトや注意事項までいただいて本当に感謝です! 重ねての質問で大変恐縮なのですが、 下記2つにつきましてもご教示いただけないでしょうか? 何とぞよろしくお願いいたします。 '----------------------------------------------------------- (1)貼り付けた画像の位置を調整したく sld.Shapes.Pasteの次行で下記のコードを挿入したところ “オブジェクト変数または With ブロック変数が……”と エラーが出てしまいました。 Withの直後のオブジェクトの指定が原因と思われるのですが、、 解決方法を教えていただけますと大変助かります。 With ppPst.ActiveWindow.Selection 'エラーの原因? .LockAspectRatio = msoTrue '縦横比固定 .Top = 100 '上からの位置 .Left = 50 '左からの位置 .Width = 800 '横幅 .Height = 600 '縦幅 .ZOrder msoSendToBack '最背面へ移動 End With '----------------------------------------------------------- (2)新規スライドに貼り付けたい追加グラフがあり、 「A1セルの語句を含むスライドの手前に新規スライドを挿入し貼付け」 という動作を追加したく、下記のような記述を追加したいのですが この i にどのような記述をするべきか教えていただけないでしょうか? 'PowerPointスライド追加 i = 'ここに特定の語句を含むスライド番号 Set ppSld = ppPst.Slides.Add(Index:=i + 0, Layout:=12) '----------------------------------------------------------- 恐縮と言いつつ長々と申し訳ありません。 いただいた参考サイトや検索などで自分でも引き続き 調べて参りますが、お知恵をお借りできましたら大変幸いです。 何とぞよろしくお願いいたします。 （もひ） 2019/07/18(木) 19:19 ---- そういう質問になりますよね、、、 なので「私も勉強がてらやってみただけなのでこれ以上は分かりません。」とけん制しておいたのですが、、、 >(1)貼り付けた画像の位置を調整したく sld.Shapes.Paste With ppPst.ActiveWindow.Selection 'エラーの原因? ↓ With sld.Shapes.Paste としたら、だめですかね。 >(2)スライドの番号 i = sld.SlideIndex では? 「For Each sld In ppPst.Slides」で、変数「sld」がスライドであることは分かると思います。 あとは、この変数のスライドの番号が取得できればいいわけで、 以下のサイトを見ると、スライド番号のプロパティ名が「SlideIndex」であることが分かります。 現在編集中のスライド番号を取得するPowerPoint VBAのコード https://www.relief.jp/docs/017912.html ※googleでキーワード「VBA スライド番号」で最初に出てくる。 ちなみに私は、sld.Shapes.Pasteにブレークポイントを設定してマクロを中断し、 ローカルウィンドウで、変数「sld」の情報を確認。 基本的に英語なので「Indexとついてるものはあるかな?」と探しました。 その上で、ネットで検索して確認。 今回はネットで調べればすぐに出てきましたが、プロパティ名が分からない時にこの方法はまたに使います。 プロパティの値が確認できるので「この値が入っているもの」（例:スライド3であれば、3と入っているもの）ってので探せるので。 （う） 2019/07/19(金) 10:45 ---- （1）貼った画像のサイズを変えるなら、以下のように貼ったオブジェクトのプロパティとして設定してしまえば良いでしょう。 With sld.Shapes.Paste .LockAspectRatio = msoTrue '縦横比固定 .Top = 100 '上からの位置 .Left = 50 '左からの位置 .Width = 800 '横幅 .Height = 600 '縦幅 .ZOrder msoSendToBack '最背面へ移動 End With （2）末尾にスライド追加するだけなら、以下とか。 ppPst.Slides.Add Index:=ppPst.Slides.Count + 1, Layout:=12 （???） 2019/07/19(金) 10:52 ---- あぁ、末尾って訳じゃないんですね。 ならsldのインデックスを元に、ですね。 （???） 2019/07/19(金) 10:56 ---- または、元々あったコードに出てきた i という変数を重要視するなら、後ろから検索していけば多重挿入問題は発生しないので、以下とか。 Sub test() Dim ppApp As Object Dim ppPst As Object Dim shp As Object Dim txtRng As Variant Dim foundText As Variant Dim i As Long Set ppApp = CreateObject("PowerPoint.Application") ppApp.Presentations.Open "プレゼンテーション1.pptx" Set ppPst = ppApp.ActivePresentation ThisWorkbook.Sheets(1).ChartObjects("グラフ 1").CopyPicture Appearance:=xlScreen, Format:=xlPicture For i = ppPst.Slides.Count To 1 Step -1 For Each shp In ppPst.Slides(i).Shapes If shp.HasTextFrame Then Set txtRng = shp.TextFrame.TextRange Set foundText = txtRng.Find(FindWhat:="あああ") If Not (foundText Is Nothing) Then With ppPst.Slides.Add(Index:=i, Layout:=12) With .Shapes.Paste .LockAspectRatio = msoTrue '縦横比固定 .Top = 100 '上からの位置 .Left = 50 '左からの位置 .Width = 800 '横幅 .Height = 600 '縦幅 .ZOrder msoSendToBack '最背面へ移動 End With End With Exit For End If End If Next shp Next i Set ppPst = Nothing Set ppApp = Nothing End Sub （???） 2019/07/19(金) 11:10 ---- う 様 ご回答いただきましてありがとうございます! 牽制いただいていると知りながらの厚かましいお願いにも 親切にご対応くださり、心から感謝いたします。 何時間にも渡りネットを調べたのですが そこで得た情報を集約するだけの基礎知識がなく、 リミットのある作業で1から勉強する猶予もなく、 どうしたものかと途方に暮れておりましたので 本当に助かりました。 ご返信、何度も読ませていただいています。 誠にありがとうございます。 '---------------------------------------------------------- （???）様 ご回答いただきましてありがとうございます! 本当に困っておりましたので、深く深く感謝いたします。 今作成しているデータをもっと良いものにできました! こちらでご相談させていただいて本当によかったです。 VBA、音を上げるほど難しいですがとても楽しいとも 感じられるのは、ひとえに貴重な知識を分けてくださる 皆さまのおかげです。 また長々と申し訳ございません。皆さまの益々のご活躍と、 よきExcelライフをお祈り申し上げます。 誠にありがとうございます。 （もひ） 2019/07/19(金) 22:50... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201907/20190716230051.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97065 documents and 608342 words.
訪問者：