VBAでExcelとPowerPointの連携

前へ 次へ
このQ&Aのポイント
  • VBAを使用して、ExcelとPowerPointを連携させる方法について説明します。
  • エクセルのデータを読み込んで、パワーポイントに貼り付ける際に、Excelウィンドウが選択されていないという不都合があります。この問題の解消方法についても説明します。
  • また、プレゼンテーション作成の終了をメッセージボックスで通知するサンプルコードも掲載します。
回答を見る
  • ベストアンサー

VBAで、ExcelとPowerPointの連携

EXCEL VBAにて、PowerPointのObjectを作って、エクセルからプレゼンテーションの作成をしています。 一旦、パワーポイントのウィンドウが選択された後、Excelのウィンドウを選択する方法がわかりません。　エクセルのデータを読み込んで、パワーポイントに貼り付ける分には、別にエクセルのウィンドウを選択する必要はないので、大きな問題ではありませんが、それでも、エクセルにて、msgboxを実行しようとすると、Excelウィンドウが選択されていないために、フラッシュして、ユーザーに「エクセルを選択しろ」と警告してきます。　この不都合を解消したいのです。 以下のサンプルにて、本当は、(1)　の位置にmsgboxを入れたいのですが、上記のことがあるので、(2)の位置にmsgboxを入れて対応しています。 (1)の位置でも、msgboxが素直に表に出てくるように「VBAコードにて、Excelウィンドウを選択する」 方法をよろしくお願い致します。 Sub test1() Dim ppApp As New PowerPoint.Application Dim PPfile As PowerPoint.Presentation With ppApp .Visible = msoTrue .Windows.Application.Left = 600 .Windows.Application.Top = 0 .Windows.Application.Width = 350 .Windows.Application.Height = 350 Set PPfile = .Presentations.Add With PPfile n = .Slides.Count With .Slides.Add(n + 1, ppLayoutTitleOnly) .Select End With End With End With PPfile.SaveAs Filename:=ThisWorkbook.Path & "\" & "mySample.ppt" PPfile.Save PPfile.Close ppApp.Quit ' MsgBox "プレゼンテーション作成終了” '------(1) Set ppApp = Nothing Set PPfile = Nothing MsgBox "プレゼンテーション作成終了” '------(2) End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.1

（１）の行の前に 　　VBA.AppActivate Excel.Application.Caption を入れてやるとどんな感じでしょう？

atom_28
質問者

補足

うまくいきました。 ありがとうございました。 色々調べました。 For i = 1 To 5 VBA.AppActivate Excel.Application.Caption waitTime = Now + TimeValue("0:00:1") Application.Wait waitTime VBA.AppActivate ("Microsoft Excel") waitTime = Now + TimeValue("0:00:1") Application.Wait waitTime VBA.AppActivate ("Microsoft PowerPoint") waitTime = Now + TimeValue("0:00:1") Application.Wait waitTime VBA.AppActivate ("Windows Internet Explorer") waitTime = Now + TimeValue("0:00:1") Application.Wait waitTime Next このprocedureで、ウィンドウの選択が移り変わります。 しかし、Windows exploreは、うまくいきません。 確かに、インターネットで調べると、Window sexploreはうまくいかないと 書かれていますが、本当にできないのでしょうか？ よろしくお願いします。

その他の回答 (1)

  • masatsan
  • ベストアンサー率15% (179/1159)
回答No.2

APIでExcelをトップに持っていくしかないのでは？

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. その他MS Office製品

関連するQ&A

  • ExcelのデータをPPTにエクスポートしたいです(VBA初心者)

    ExcelのデータをPPTにエクスポートしたいです(VBA初心者) ネット検索などをして、下記の手順でエクスポートすることまではできたのですが、 これだと全てのセルデータがPPTの1つのテキストに入ってしまいます。 希望しているのは、セルごとにエクスポート先の テキストボックスを分けたいのですが、 ここから先が分かりません。 どなたかご教授いただけませんか。 よろしくお願いします。 <Excel> A B C D E １ 会社名(1) 住所(1) 担当者(1) ２ 会社名(2) 住所(2) 担当者(2) ３ 会社名(3) 住所(3) 担当者(3) <PPT> ・Sheet1 テキストボックス1　　　会社名(1) テキストボックス2　　　住所(1) テキストボックス3　　　担当者(1) ・Sheet2 テキストボックス1　　　会社名(2) テキストボックス2　　　住所(2) テキストボックス3　　　担当者(2) --------------------------------------- Sub ExceltoPowerPoint() Dim objRng As Range Dim varRng As Variant Dim intSNum As Integer Dim i, j As Integer Dim PpApp As PowerPoint.Application Dim PpPrs As PowerPoint.Presentation Set objRng = Worksheets("Sheet1").Range("A1:C5") varRng = objRng.Value Set objRng = Nothing Set PpApp = CreateObject("PowerPoint.Application") Set PpPrs = PpApp.Presentations.Add PpApp.Visible = True intSNum = 1 For i = 1 To UBound(varRng, 1) PpPrs.Slides.Add i, ppLayoutBlank PpPrs.Slides(i).Shapes.AddTextbox msoTextOrientationHorizontal, 0, 0, 710, 540 Next For i = 1 To UBound(varRng, 1) For j = 1 To UBound(varRng, 2) With PpPrs.Slides(intSNum).Shapes(1).TextFrame.TextRange If j = UBound(varRng, 2) Then .Text = .Text & CStr(varRng(i, j)) & vbNewLine intSNum = intSNum + 1 Else .Text = .Text & CStr(varRng(i, j)) & vbNewLine End If End With Next Next For i = 1 To UBound(varRng, 1) With PpPrs.Slides(i).Shapes(1).TextFrame.TextRange .Font.NameAscii = "Arial" .Font.NameFarEast = "ＭＳ Ｐゴシック" .Font.NameOther = "Arial" .Lines(1).Font.Size = 10 '1行目 .Lines(2).Font.Size = 30 '2行目 .Lines(3).Font.Size = 20 '3行目 End With Next MsgBox "処理が終了しました。" Set PpPrs = Nothing Set PpApp = Nothing End Sub ---------------------------------------

  • excel vba ppt テキストボックス中央揃

    したい事：エクセルからパワーポイントを作成したい 　　　　　　テキストボックスを作成 　　　　　　テキストボックスの文字を中央揃え←ここができないのです；； すいません、色々試したのですが中央揃えができません、どなたかご指導して頂けないでしょうか？ ↓途中までのソース Sub PP作成_Click() Dim app As Object Dim pre As Object Dim sld 　　Dim sh As Object Set app = CreateObject("powerpoint.application") app.Visible = True ' // PP を表示する app.Visible = True ' // PP 新規プレゼンテーション作成 Set pre = app.Presentations.Add(WithWindow:=True) ' // PP 新規スライド挿入 Set sld = pre.Slides.Add(Index:=1, Layout:=12) 　　Set sh = sld.Shapes.AddTextbox(msoTextOrientationHorizontal _ , 100, 100, 200, 50) 　　With sh.TextFrame.TextRange 　　 .Text = "テスト" .Font.Size = 100 .Font.Name = "HGP創英角ゴシックUB" 　　End With End Sub

  • ExcelのVBAで得た結果を転記したい

    Excelで，ひとつのブックの余白や印刷倍率，印刷品質を表示するのに，次のようなVBAを用いています． '上余白を表示する ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup marginInches = ActiveSheet.PageSetup.TopMargin / _ Application.CentimetersToPoints(1) MsgBox "現在の上余白は " & marginInches & " センチです。" End With '下余白を表示する With ActiveSheet.PageSetup marginInches = ActiveSheet.PageSetup.BottomMargin / _ Application.CentimetersToPoints(1) MsgBox "現在の下余白は " & marginInches & " センチです。" End With '左余白を表示する With ActiveSheet.PageSetup marginInches = ActiveSheet.PageSetup.LeftMargin / _ Application.CentimetersToPoints(1) MsgBox "現在の左余白は " & marginInches & " センチです。" End With '右余白を表示する With ActiveSheet.PageSetup marginInches = ActiveSheet.PageSetup.RightMargin / _ Application.CentimetersToPoints(1) MsgBox "現在の右余白は " & marginInches & " センチです。" End With 'ヘッダー余白を表示する With ActiveSheet.PageSetup marginInches = ActiveSheet.PageSetup.HeaderMargin / _ Application.CentimetersToPoints(1) MsgBox "現在のヘッダーは " & marginInches & " センチです。" End With 'フッター余白を表示する With ActiveSheet.PageSetup marginInches = ActiveSheet.PageSetup.FooterMargin / _ Application.CentimetersToPoints(1) MsgBox "現在のフッダーは " & marginInches & " センチです。" End With '印刷倍率を表示する With ActiveSheet.PageSetup Zoom = ActiveSheet.PageSetup.Zoom MsgBox "現在の印刷倍率は " & Zoom & " パーセントです。 " End With '印刷品質を表示する Dim PrintQuality As Variant With ActiveSheet.PageSetup PrintQuality = .PrintQuality(1) MsgBox "現在の印刷品質は" & PrintQuality & "dpiです。" End With 現在，ツールバーのボタンをおして起動させているのですが， シート数が多い時は手間になり，困っています． （ボタンのコードは以下） Private Sub Workbook_AddinInstall() Dim myBar As CommandBar Dim CKB1 As CommandBarButton Dim Exist As Boolean For Each myBar In Application.CommandBars '名前が"余白"であるならばフラグを立てる If myBar.Name <> "余白" Then Exist = False Else Exist = True If Exist = True Then Exit For Next myBar '既に作成されていなければ新規作成 If Exist = False Then _ Set myBar = Application.CommandBars.Add(Name:="余白", Position:=msoBarTop) With myBar Set CKB1 = .Controls.Add(Type:=msoControlButton) CKB1.Caption = "余白" With CKB1 .Style = msoButtonCaption .FaceId = 266 .Parameter = "余白" .OnAction = "余白" End With .Visible = True End With Set myBar = Nothing Set CKB1 = Nothing End If End Sub そこで， シートごとに上記の余白等の結果を， テキストファイルなどに転記できるようにしたいのですが， VBAで可能でしょうか？ （以下のような感じです） sheet1 上：40 下：20 左：30 右：10 倍率：98 品質：600

  • エクセル2007で自前のツールバーを作る方法

    エクセル2000です。 以下のマクロで自前の新しいツールバーが作れ、作動します。 ところがエクセル2007ではうんともすんとも言ってくれません。 エクセル2007で使う場合はどのようにしたらよいでしょうか？ ユーザーフォームで似たようなものを作る方法はわかるのですが、できれば以下の方法を使いたいのです。 Sub 三択メニュー() On Error Resume Next Application.CommandBars("選択します").Delete On Error GoTo 0 Application.CommandBars.Add Name:="選択します", Position:=msoBarFloating With Application.CommandBars("選択します") .Visible = True .Controls.Add Type:=msoControlButton With .Controls(1) .Style = msoButtonCaption .Caption = "⇒メニュー１　" .OnAction = "Msg_1" End With .Controls.Add Type:=msoControlButton With .Controls(2) .Style = msoButtonCaption .Caption = "⇒メニュー２　" .OnAction = "Msg_2" End With .Controls.Add Type:=msoControlButton With .Controls(3) .Style = msoButtonCaption .Caption = "⇒メニュー３　" .OnAction = "Msg_3" End With End With End Sub Sub Msg_1() Application.CommandBars("選択します").Delete MsgBox "追加コマンド１を処理しました。" End Sub Sub Msg_2() Application.CommandBars("選択します").Delete MsgBox "追加コマンド２を処理しました。" End Sub Sub Msg_3() Application.CommandBars("選択します").Delete MsgBox "追加コマンド３を処理しました。" End Sub

  • VB6.0でPowerPoint上のイベントを取得したい

    VB6.0からPowerPointのファイルを開き、 PowerPoint上のイベントを取得したいのですが、 方法が分からず困っております。 具体的には、ツールバーのプレビューボタンが クリックされたことをVBで検知したいと考えています。 現状では下記のように、Applicationの閉じるイベントは 取得できたのですが、そこからどうして良いか分からない状態です。 良きアドバイスをお願い致します。 ---------------------------------------------------- Option Explicit Private WithEvents PPTApp As PowerPoint.Application '■パワポを開く Private Sub Command1_Click() Set PPTApp = New PowerPoint.Application PPTApp.Visible = True PPTApp.Presentations.Open (App.Path & "\test.ppt") End Sub '■パワポを閉じる Private Sub Command2_Click() PPTApp.Quit Set PPTApp = Nothing End Sub '■閉じるイベントを取得 Private Sub PPTApp_PresentationClose(ByVal Pres As PowerPoint.Presentation) MsgBox "閉じる" End Sub ----------------------------------------------------

  • VBA　新規にエクセルを開き既存のファイルを開く

    VBAで新規にエクセルのアプリケーションを起動し、 その中に既存のファイルを起動する方法は有りますか？ Sub Sample() Dim appExcel As Excel.Application Dim WSH As Variant Dim strPath As String Set appExcel = New Excel.Application Set WSH = CreateObject("Wscript.Shell") strPath = ActiveWorkbook.Path With appExcel .Visible = True .Workbooks.Add .ActiveWorkbook.SaveAs (strPath & "\ test.xls") End With Set WSH = Nothing End Sub このコードは、ネットから拾ったサンプルコードなのですが 新しいアプリケーションでエクセルを立ち上げることはできたのですが 新規のブックが開いてしまい、 更に、開きたいファイルに上書き保存してしまいそうです。 新規のブックが開く原因は .Workbooks.Addで、 上書き保存する原因は .ActiveWorkbook.SaveAs だとわかってるのですが、 この部分を同変更すればいいのかがわかりません。 Workbooks.Open?Filename:="C:\Users\test.xlsx" だと、現在実行しているvbaファイルを同じ枠内で 該当のファイルが開いてしまいます。

  • エクセルVBAで動的にコンボボックスを作成

    一枚のシートに動的に複数のコンボボックスとコマンドボタンを生成しようとしています。 標準モジュールのループでコントロールを生成していますが、一周は上手く回るのですが、２週目から コンボボックス作成MakeComboの中のここでおちると記載している部分でエクセルのアプリケーションエラーに なってしまい、エクセルが落ちてしまいます。 With clsExcel.objWs 'コンボボックスの位置を指定 Dim cmbPos As Range Set cmbPos = .Range(.Cells(k, 4), .Cells(k, 4)) 'コンボボックスを作成 Set m_objOLE_C = .OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False,DisplayAsIcon:=False, _ Left:=cmbPos.Left, Top:=cmbPos.Top, Width:=63, Height:=15) End With Dim objCmb As ComboBox Set objCmb = clsExcel.objWs.OLEObjects(m_objOLE_C.name).Object objCmb.Locked = False With objCmb '--コンボボックスに初期値をセット .AddItem "計", 0 .AddItem "推", 1 .AddItem "確", 2 .AddItem "積", 3 '-------------------------------------------- ' For j = 0 To 3 ' If strData = .List(j) Then ' .ListIndex = j '<-----ここでおちる ' Exit For ' End If ' Next j '-------------------------------------------- End With Set cmbPos = Nothing Set objCmb = Nothing Set m_objOLE_C = Nothing End Sub

  • ExcelのVBAで、application.inputboxで、開いている他のブックを選択できません。

    いつもお世話になっております。 ExcelのVBAで、application.inputboxで他のブックを選択したいのですが、どうも出来ません。下記のコードを実行して、InputBoxで、他のブックのセルを指定したいのですが、どうも現在開いている他のブックをマウスでクリック出来ないのです。 下記のコードは、『選択範囲を、InputBoxで指定した先にコピーしたい』という意図から、まずは、Msgboxに表示してみることにしたものです。 これは、何故なのでしょうか？ ご教示下さい。 'rngOriginalを、rngCopyToにコピーします。 Sub Test() Dim rngOriginal As Range Dim rngCopyTo As Range Set rngOriginal = Selection.Cells　 Set rngCopyTo = Application.InputBox("コピー先を選択してください", , , , , , , 8) With rngOriginal MsgBox .Parent.Parent.Name & " " & .Parent.Name & "!" & .Address(, , Application.ReferenceStyle) End With With rngCopyTo MsgBox .Parent.Parent.Name & " " & .Parent.Name & "!" & .Address(, , Application.ReferenceStyle) End With End Sub

  • 【.NET】PowerPointのSlideオブジェクトの解放について

    　 　こんにちは，.NETでOfficeを扱う際の解放について勉強をしております． 質問させていただきます．どうぞよろしくお願いいたします． 　PPT2007の文字を操作しておりますが， 　　　　Dim myAPP As PowerPoint.Application 　　　　myAPP = CreateObject("PowerPoint.Application") 　　　　Dim myAPPpre As PowerPoint.Presentation 　　　　　・・・ 　　　　myAPPpre = myAPPpres.Open(Mypath & FName, WithWindow:=Microsoft.Office.Core.MsoTriState.msoFalse) のあと， 　　　　Dim myS As PowerPoint.Slide 　　　　Dim mySlides As PowerPoint.Slides 　　　　　　・・・・・ 　　　　　　mySlides = myAPPpre.Slides 　　　　　　MRComObject(mySlides) : mySlides = Nothing だとPOWERPNT.EXEがすぐに解放されますが， 　　　　Dim myS As PowerPoint.Slide 　　　　Dim mySlides As PowerPoint.Slides 　　　　　　・・・・・ 　　　　　　mySlides = myAPPpre.Slides 　　　　　　For Each myS In mySlides　　　　　　　'追加行 　　　　　　　　MRComObject(myS) : myS = Nothing　'追加行 　　　　　　Next 　　　　　　　　　　　　　　　　'追加行 　　　　　　MRComObject(mySlides) : mySlides = Nothing と，Slideオブジェクトを入れると解放されなくなってしまいます． 文字列の操作は正常に動作いたしますが． 　「Dim myS As PowerPoint.」まで打ったところで一覧で出される候補名を確認しましたところ Slideだけ，Slides等他のオブジェクトとロゴマークが異なるのですが，これは関係あるのでしょうか？？ またこの一覧の下の方に「_Slides」なるものも見つけ試してみましたが，うまくいきません． 　OKWaveでアドバイスいただく前にネット検索につきましてもしっかり行ってみたつもりなのですが， よくわかりませんでした．（もし検索が下手でしたらどうもすみません．．．） 　もしお詳しい方がいらっしゃいましたら，是非ともアドバイスいただきたくお願いいたします． どうぞよろしくお願いします．

  • エクセルVBAでパワーポイントを開き、表に文字を挿入jpeg保存時の実行時エラー

    エクセルVBAでパワーポイントを開き、パワーポイント表に文字を挿入、名前の付けてjpeg保存にする段階で『実行時エラー424オブジェクトが必要です』でエラーになります。丸１日原因を探しましたがわかりません。大変こまっております。どなたかご教授くださいm(__)m Sub Macro() Dim objPPT As Object '参照設定すれば　 　　PowerPoint.Application Dim myPre As Object 'PowerPoint.Presentation Dim Sld As Object 'PowerPoint.Slide Dim Shp As Object 'PowerPoint.Shape Dim myRow As Object 'PowerPoint.Row Dim myCell As Object 'PowerPoint.Cell Dim mySht As Worksheet Dim n As Long Dim j As Long Dim fd As FileDialog 'ファイルダイアログ '任意のファイル呼び出し Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = True .Filters.Add "PowerPointファイル", "*.ppt; *.pps; *.pptx; *.pptm", 1 If .Show <> -1 Then Exit Sub End With Set mySht = ActiveSheet 'パワーポイント起動 Set objPPT = CreateObject("PowerPoint.Application") objPPT.Visible = True i = mySht.Range("A" & Rows.Count).End(xlUp).Row + 1 '行カウンタ初期化 For n = 1 To fd.SelectedItems.Count '取得したファイルの情報のオブジェクトの数 'パワポファイル開く Set myPre = objPPT.Presentations.Open(fd.SelectedItems.Item(n), True) For Each Sld In myPre.Slides 'スライドループ For Each Shp In Sld.Shapes '図形ループ If Shp.HasTable Then '表発見 For Each myRow In Shp.Table.Rows '行ループ For Each myCell In myRow.Cells 'セルループ myCell.Shape.TextFrame.TextRange.Text = "おはよう" Next Next End If Next Next Next n 'ファイルの保存（ここで実行エラー） ActivePresentation.SaveAs Filename:="C:\power.jpg", FileFormat:=ppSaveAsJPG, EmbedTrueTypeFonts:=msoFalse 'パワポファイル閉じる myPre.Close objPPT.Quit 'パワーポイント終了 Set myCell = Nothing Set myRow = Nothing Set Shp = Nothing Set Sld = Nothing Set myPre = Nothing Set objPPT = Nothing MsgBox ("処理が終了しました") End インデントがうまく表示されないので、ホームページにアップロードしました。よろしくお願いいたします。 http://www.geocities.jp/tmp025tmp/test.html

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する