出産前後の痔にはご注意!

Excelの2つのファイル(東西、南北)から、PowerPointの1つのファイル(「一覧」)へ画像を貼り付ける作業がよくあるのですが、手順を簡素化するアイディアは有りませんでしょうか?
貼り付ける目的は、画像が重たい(Excel30000行分x10系列)ので、軽くするため&東西と南北を並べて一覧にするためで、

グラフをPowerPointに「形式を選択して貼り付け>拡張メタファイル」し、
→それをすぐ切り取って、PowerPointに「形式を選択して貼り付け>png」します

が(1回目の変換ではpngが選べない)、この手順は業務命令で指示されているので、変えられません。(私自身は二度変換する意味自体を良くわかっていませんが、それはこの質問と直接関わりありません)

これをグラフ40枚分行うのですが、自動化するか(マクロの組み方は私は知りません)、pngへ一括変換・一発変換する方法はありませんか?(現状、1枚当たりに相当な時間がかかっています。)
XPでExcel2003で、PowerPointも2003だと思います。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

補足ありがとうございました。



具体的に書いていただき、回答するに励みになりました。

どうも PP のグラフィックは美しくありません。Excel や Word と比較してそう思います。
経験からアドバイスすると Excel のグラフを最もきれいに、かつ軽量にPP に貼り付けるには、

  1. Excel で次の VBA を実行し、グラフをピクチャー(ここでは拡張
    メタファイル)としてコピーする

    ActiveChart.CopyPicture xlScreen, xlPicture

  2. PowerPoint にそのままで貼り付け

という手順が良いと思います。PP 側で「形式を選んで・・・」で拡張メタファイルにしても画質が明らかに落ちてます。

 # Excel2003、2007 ではわかりませんが。

下記は、アクティブブック内にある全てのグラフを PP に貼り付けます。

もともとのデータが大きいみたいですから、ある程度時間はかかるでしょう。とりあえず、お試しを。

' // 標準モジュール

Sub XLグラフをPPに貼り付け()

  ' // グラフウインドウとなっているものは対象外です。

  Dim ppApp    As Object ' PowerPoint.Application
  Dim ppPst    As Object ' PowerPoint.Presentation
  Dim ppSld    As Object ' PowerPoint.Slide
  Dim Sh      As Worksheet
  Dim Obj     As Object
  Dim iCount    As Integer
  Dim sngPosOffset As Single
  Dim i      As Long
  
  ' // PowerPoint(以下PP) 定数
  Const ppLayoutBlank = 12
  Const ppPasteEnhancedMetafile = 2
  
  ' // PP 起動
  On Error Resume Next
  Set ppApp = CreateObject("PowerPoint.Application")
  If ppApp Is Nothing Then Err.Raise 1000, , "PowerPoint cannot be started."
  On Error GoTo Err_
  
  ' // PP を表示する
  ppApp.Visible = True
  ' // PP 新規プレゼンテーション作成
  Set ppPst = ppApp.Presentations.Add(WithWindow:=True)
  ' // PP 新規スライド挿入
  Set ppSld = ppPst.Slides.Add(Index:=1, _
                 Layout:=ppLayoutBlank)
  ' // XL 処理グラフ数カウンタ
  iCount = 0
  ' // PP グラフ貼り付け位置初期値
  sngPosOffset = 0
  
  ' // XL グラフの貼り付け開始
  For Each Sh In ActiveWorkbook.Worksheets
    For i = 1 To Sh.ChartObjects.Count
      ' // XL グラフを Picture 形式でコピー
      Sh.ChartObjects(i).CopyPicture xlScreen, xlPicture
      ' // PP 貼り付け
      ppSld.Shapes.Paste
      ' // PP グラフ位置・サイズ補正
      With ppSld.Shapes(i)
        .LockAspectRatio = msoTrue
        .Top = sngPosOffset
        .Left = sngPosOffset
        .Height = .Height * 0.5   ' // 50%縮小
      End With
      ' // PP 次の貼り付け位置オフセット
      sngPosOffset = sngPosOffset + 20
      ' // XL 処理グラフ数カウンタ
      iCount = iCount + 1
    Next i
  Next Sh
  If iCount = 0 Then ppApp.Quit
  MsgBox CStr(iCount) & "枚のグラフを処理しました", vbInformation
  
Bye_:
  On Error GoTo 0
  Set ppApp = Nothing: Set ppPst = Nothing
  Set ppSld = Nothing: Set Sh = Nothing
  Exit Sub
Err_:
  MsgBox Err.Description, vbCritical
  Resume Bye_
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます(短いですが#3へのお礼にまとめさせていただきます。)

お礼日時:2007/08/30 20:10

追伸


どうしても PNG でなければダメなようなら、その旨補足して下さい。
別の方法で回答します。

この回答への補足

本題からそれ過ぎるのも良くないので、この質問ページは今夜24時以降に締め切る予定です、と前置きします。

>> PP のグラフィックは美しくありません。

全く同感です(それほどモノを知っているわけではありませんが)。でもPNGってこんなものかな、と思っていたのですが、むしろPPの性質に依るところが大きいのですね。メタファイルについても不満を持っていました。特に、グラフ内のテキストボックスが大きさ・位置関係が変わってしまうのを意のままに制御できず、もどかしいです。しかし、メタファイル形式はメタファイル形式で利点もあるようだから、おっしゃるように適切に使いわけることが肝要みたいですね。長く答えていただいたおかげで関心を持つきっかけになりました。


VBAについて、もマクロについて、も勤め先の他人まかせにしていて、学ぼうという姿勢に欠けていました。実は私はMSDOSは3年、日本語BASICは5年勉強して、プログラミングも多数したことがあり、TurboPASCALは3日間、JAVAは3週間独学したことがあります。しかし、BASICの頃の思いこみが強過ぎて、行番号のない言語、特にJAVAの「オブジェクト指向」や「クラス」という概念が頭に入ってきませんでした。
#2で書いていただいたプログラム(これも「マクロ」と呼べば良いのでしょうか?)は、言語こそ知りませんが、初めて「理解できる」VBAでした。とてもきれいなプログラムを書く人ですね。ありがとうございます。
(お礼へ続く)

補足日時:2007/08/30 21:35
    • good
    • 0
この回答へのお礼

(補足の続き)
これを読み解くと、VBAを自分でも書いてみようかな、という自信がわいてきました。なるほど、「こんなことできたらいいな」は「自分で書いてみる」という前向き姿勢が大切なのですね。「Excelは不便だなぁ。こんなことできないかなぁ。なんだできないのか」と思うことが実はあったのですが、逆にExcelは「やってみたいこと」をたいてい実現できる、自由度の高いアプリなのかも知れない、と思い直しました。
VBAが用意され、Office内や、社外品とも互換性が高いこと自体、Microsoftは私の思っていた以上に「やる」企業なのかも知れません。WikipediaのVBA項目に

「Visual Basic for Applications を使用することで、ExcelやAccessなどを使用した定型業務を自動化することができる。また、ユーザー独自のフォームを作成することができ、様々なプラグインを組み込むことでアプリケーションの機能をカスタマイズすることなども可能である。」

と書いてありましたが、まさにその通りですね。
#2で書いていただいたプログラムを、私自身で解釈し改良できるように勉強して、使ってみよう、と思いました。これもチンプンカンプンでなく「私にもできそう」というヒントを与えてくださったKenKenSPさんのおかげです。ありがとうございました。

もしよろしければ、
・VBAは(他の言語と比べて)とっつき易いか。極端な話、中学校でも教えられるくらいユニバーサルか。
・VBAを学び始めた時は、どんなものを参考に(2000円くらいの本?)し、どんなプログラムから始めたか
などを続報で教えてください。

お礼日時:2007/08/30 21:36

> この手順は業務命令で指示されているので、変えられません。



変えられないものに対して新たな方法を回答したとしても解決に
ならないというか..その辺はどうなんです?

回答としては、VBA を使えば省力化は可能です。

> 画像が重たい(Excel30000行分x10系列)ので、軽くする
> ため&東西と南北を並べて一覧にするためで

Excel30000行分x10系列とは?
東西と南北とは?

あなたの業務を知らない人がほとんどなのですから、現状がよく
わかるように具体的に説明して下さい。
VBA を使えば Excel ファイル内にある全ての グラフ・写真を
PNG ファイルで直接書き出すことも、それを PowerPoint に
自動で貼り付けていくことも可能です。
が、現状がわからないことにはどうしようもない。

> 二度変換する意味

標準機能で Excel では グラフ-->PNG 変換ができないからだと
思いますが、本当の意図は不明です、、というか謎ですね。

そもそも「軽く」という点を一番重視するのであれば、グラフなら
拡張メタファイル(以下 EMF)で貼り付けたままにすべきです。

 # ラスタ画像とベクタ画像の違いを調べて下さい

EMF で貼り付けたグラフを わざわざ PNG で貼り付け直すという
ことはファイルサイズを不必要に巨大化させ、画質も劣化するの
ですが。。。

ペイントなどからコピペで貼り付けた写真などなら効果はあると
思います。これは、Bitmap で貼り付いているものを PNG に変換
することでファイルサイズが小さくなる可能性があるからです。

この回答への補足

あまり長くならないように、とはしょりましたが、はしょり方がわかりにくかったようですね。ま、このご回答で知りたいことの多くは見えてきました。
東西とか南北とかいうのはあくまでも例えですが、
東の部屋について気温、湿度、二酸化炭素濃度、・・・など10系列のデータをとっており、それがエクセル3万行分くらいのデータ量なので、グラフを描画させると、時間がかかる、ということを表現したかったのです。しかもグラフが東の部屋だけで10枚あります。
西の部屋、北の部屋、南の部屋についても同様のデータを取りグラフを作っていますが、東西南北を全て一つのファイルに納めると大きいので、「東西」「南北」という2つのファイルに分けているだけのことです。

この2つのエクセルファイルは開く・閉じるだけでもかなり重たいので、グラフだけをパッと見られるように「一覧」というパワーポイントファイルを作っているわけですが、
1つ1つのグラフを、コピって貼ってまた切り取って変換して貼って、という作業が時間がかかるので、
「業務指示からは逸脱しない」範囲で、多少比較的早く、グラフを移す方法はないか、を聞きたかったのです。
私のイメージでは、エクセル上で、グラフ10~20枚をPNGに一気に変換できればなぁ、と淡く期待していたのですが。もちろん、現状たったの1枚のグラフでもめちゃくちゃ時間がかかっているので(散布図で10色の線が入り乱れている)、20枚一気に、なんてスーパーマンみたいなことはありえない(メモリ的にも)、てことはわかっています。

自動で解決する方法があることはわかりましたし、
わざわざPNGにするのはデメリットがある、ということも上司に言ってみようかと思います。役に立ちました。

補足日時:2007/08/30 12:47
    • good
    • 0
この回答へのお礼

ありがとうございます(短いですが#3へのお礼にまとめさせていただきます。)

お礼日時:2007/08/30 20:10

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセルから表をパワーポイントへ貼り付けたときの、位置調整がうまくいきません

エクセルから表をパワーポイントへ貼り付けたときの、位置調整がうまくいきません。宜しくお願いします。

--------------------
sub test1()

Dim pptApp As Object
Dim pptPre As Object
Dim tempFileName As String

Dim macrofile As String 'エクセルの貼り付け元のファイル名
Dim sht As String 'エクセルの貼り付け元のシート名


Dim page As Integer 'パワーポイントへの貼り付けたいページ
Dim picPos_yoko As Long 'パワーポイントへの貼り付け横位置
Dim picPos_tate As Long 'パワーポイントへの貼り付け縦位置

macrofile = "sample001.xls"
sht = "sheet1"


tempFileName = ThisWorkbook.Path & Application.PathSeparator _
& macrofile


Set pptApp = CreateObject("powerPoint.Application")

With pptApp
.Visible = True
Set pptPre = .Presentations.Open(tempFileName)
End With



Workbooks(macrofile).Worksheets(sht).Activate
Range("A1").CurrentRegion.Copy '表のコピー


With pptPre.Slides(page)
.Shapes.Paste.Name = "hyou1"
With .Shapes("hyou1")
.Top = picPos_yoko
.Left = picPos_tate
End With
End With


End Sub
------------------------

.Shapes.Paste.Name = "pic1"
↑この行で名前をつけたかったがうまく名前がついていない。
 貼り付けた表の名前をパワーポイントのマクロの記録で確認したところ "Group 288"と名前がついていた

With .Shapes("hyou1")
↑当然この行で"hyou1"は見つからないというエラーが出てしまう。


表をエクセルからコピーして、パワーポイントへ位置を指定して張り付けるかもしくは貼り付けた後に移動ができるかを実現したい。
何かいい方法はありませんか?パワーポイントへエクセルからグラフを貼り付けた場合はうまくいきました。
また。パワーポイントの表の名前のつけ方には規則性があるのでしょうか。規則性があれば、それに則ってコードをかけるのですが・・・。

エクセルから表をパワーポイントへ貼り付けたときの、位置調整がうまくいきません。宜しくお願いします。

--------------------
sub test1()

Dim pptApp As Object
Dim pptPre As Object
Dim tempFileName As String

Dim macrofile As String 'エクセルの貼り付け元のファイル名
Dim sht As String 'エクセルの貼り付け元のシート名


Dim page As Integer 'パワーポイントへの貼り付けたいページ
Dim picPos_yoko As Long 'パワーポイントへの貼り付け横位置
Dim picPos_tate As Long ...続きを読む

Aベストアンサー

書き忘れました。
下のコードにして、名前が変更されていることも確認してください。
オブジェクト名: hyou1 になると思います。

 With pptPre.Slides(page).Shapes
  .Paste
  With .Item(.Count)
   .Name = "hyou1"
   .Top = picPos_tate
   .Left = picPos_yoko
   MsgBox "オブジェクト名: " & .Name
  End With
 End With

QPowerPoint VBA 画像のサイズ

こんにちは。

PowerPoint2007 VBAで今選択している画像のサイズを
指定のサイズに変える方法を教えていただけないでしょうか。
出来ればコードも書いていただけると嬉しいです

MSDN等調べれば出てくるかとも思ったのですが、
VBA自体をExcelで少し触った程度なので分かりませんでした。

よろしくお願いします。

Aベストアンサー

1個づつでもよければ下記でできます。
WindowとslideがわかればあとはExcelと同じです。

Sub test()
Dim w As Single
Dim h As Single

w = 200
h = 200
With ActiveWindow.Selection
With .SlideRange.Shapes(.ShapeRange.Name)
.Width = w
.Height = h
End With
End With

End Sub

QExcelとPowerPointをVBAで連携させる方法

おけましておめでとうございます。
本年もよろしくお願いします。
で、本題ですが、
(Win95でExcel2000とPowerPoint2000を使用)
EXCELのデータベースの表を順々にPowerPointのテキストボックスへ
コピーして印刷するためにVBAを作成したいと思ってます。
(印刷形式がPowerPointのため)
ここには作成できるんですが、両者のVBAをどのように
連携させるかわかりません。
よろしくご教授ください。

また、PowerPointのVBAでマクロの記録を使わず、オブジェクト名
(("Text Box 1")とか)を知る方法もあわせてよろしくご教授ください。

Aベストアンサー

>オブジェクト名はVBAを使わずにパワーポイント上だけでは確認しようが無いと言うことでしょうか。

絶対できないとまでは断言できる自信はないのですが、少なくともその方法は知りません。

オブジェクト名はVBAを使えば変更することはできます。
Application.ActiveWindow.Selection.SlideRange.Shapes.Item(1).Name = "New Name 1"

だだ、この設定した名称が勝手に変更されることはないのかどうか自信がありません。少なくとも自動的に生成した「オブジェクト名」は勝手に変更されてしまいます。

QVBAで既存のパワポのファイルを開くには?

アクセスやエクセルからVBAで既存のパワポのファイルを開くには?

参照設定をして、
Sub test()
Dim App As PowerPoint.Application
Dim MyFileName As String

Set App = CreateObject("PowerPoint.Application")

MyFileName = CurrentProject.Path & "サンプル.ppt"
App.Visible = True

Set App = Nothing
End Sub

を実行すると、パワポの空のアプリケーション開きますが肝心のファイルが開きません。

開く方法を教えてください。

Aベストアンサー

ExcelファイルやAccessファイルと
パワーポイントのファイルが同じフォルダにあるとして
Accessなら、CurrentProject.Path
Excelなら、ThisWorkbook.Path
でフォルダ名までが得られますので、それに \ を付け足して
CurrentProject.Path & "\" & "サンプル.ppt"

パワーポイントに参照設定を行っているのですから
CreateObjectせずに
Sub PPTopen()
Dim pp As New PowerPoint.Application
pp.Presentations.Open ThisWorkbook.path & "\" & "サンプル.ppt"
以下省略
で。
開くだけで、その後はVBAでパワーポイントを操作しないのであれば
Shell ("explorer.exe" & Chr(32) & ThisWorkbook.path & "\" & "サンプル.ppt"
↑読み取り専用で開かれました。当方 Office2010 の場合
↓PPTファイルをダブルクリックで開いた状態
CreateObject("shell.application").shellexecute ThisWorkbook.path & "\" & "サンプル.ppt"
とかでも。

ちなみにパワーポイントは数年来使ったことはありませんので
これ以上のことはご勘弁ください。

ExcelファイルやAccessファイルと
パワーポイントのファイルが同じフォルダにあるとして
Accessなら、CurrentProject.Path
Excelなら、ThisWorkbook.Path
でフォルダ名までが得られますので、それに \ を付け足して
CurrentProject.Path & "\" & "サンプル.ppt"

パワーポイントに参照設定を行っているのですから
CreateObjectせずに
Sub PPTopen()
Dim pp As New PowerPoint.Application
pp.Presentations.Open ThisWorkbook.path & "\" & "サンプル.ppt"
以下省略
で。
開くだけで、その後はVBAでパワーポイント...続きを読む

QEXCELグラフをPowerPointに貼り付ける作業のマクロ化

EXCELで造ったグラフをコピーして、PowerPointで、形式を選択して貼り付けでピクチャ(拡張メタファイル)で貼り付ける作業のマクロ化を
行いたいと考えておりますが、PowerPoint側の操作をマクロ記録しても記録されません。何か良い方法はありますか?
※バージョンはOffice2000です。

よろしくお願いします。

Aベストアンサー

なんと、形式を選択して貼り付けは、PowerPoint2000のマクロではサポートされていません。2002からのサポートです。
このため、対応するマクロがないので、記録しても記録されません。
代替策として、以下のURLをMSは提供しています。
http://support.microsoft.com/kb/222721/ja

参考URL:http://support.microsoft.com/kb/222721/ja

QパワーポイントVBAでグラフのサイズ・位置を統一

パワーポイントVBAに貼付けた複数のグラフサイズを統一したいと思っています。
1~20枚目のスライドに、それぞれ2つのグラフが貼付けてあります。
全てのグラフサイズ・位置を統一したいと思い、以下の様なVBAを書いてみました。

----------
Sub 表サイズの統一()
Dim myTop1, myLft1, myHgt1, myWdt1, cnt, i, myTop2, myLft2, myHgt2, myWdt2
With ActivePresentation.Slides(1).Shapes(1)
myTop1 = .Top
myLft1 = .Left
myHgt1 = .Height
myWdt1 = .Width
End With

With ActivePresentation.Slides(1).Shapes(2)
myTop2 = .Top
myLft2 = .Left
myHgt2 = .Height
myWdt2 = .Width
End With

cnt = ActivePresentation.Slides.Count

For i = 2 To cnt
With ActivePresentation.Slides(i).Shapes(1)
.Top = myTop1
.Left = myLft1
.Height = myHgt1
.Width = myWdt1
End With
Next

For i = 2 To cnt
With ActivePresentation.Slides(i).Shapes(2)
.Top = myTop2
.Left = myLft2
.Height = myHgt2
.Width = myWdt2
End With
Next
End Sub
----------
各スライドにある1つ目のグラフのサイズは統一出来たのですが、2枚目のグラフは何の変化もおきません。

どこが悪いのか、どなたかご教示頂ければ幸いです。
どうぞよろしくお願い致します。

パワーポイントVBAに貼付けた複数のグラフサイズを統一したいと思っています。
1~20枚目のスライドに、それぞれ2つのグラフが貼付けてあります。
全てのグラフサイズ・位置を統一したいと思い、以下の様なVBAを書いてみました。

----------
Sub 表サイズの統一()
Dim myTop1, myLft1, myHgt1, myWdt1, cnt, i, myTop2, myLft2, myHgt2, myWdt2
With ActivePresentation.Slides(1).Shapes(1)
myTop1 = .Top
myLft1 = .Left
myHgt1 = .Height
myWdt1 = .Width
End With

With ActivePr...続きを読む

Aベストアンサー

失礼ながら、2003で試行してみましたが、
ご提示のコードできちんと動きます。

なので
> どこが悪いのか
具体的な指摘は出来かねるのですが・・

For i = 2 To cnt
  With ActivePresentation.Slides(i)
    .Select
    With .Shapes(2)
      .Select
      .Top = myTop1

として、ステップインで実行してみると原因が掴めるかもしれません。



余計なお世話かもしれませんが、

Sub 表サイズの統一()
Dim myTop1, myLft1, myHgt1, myWdt1, cnt, i, myTop2, myLft2, myHgt2, myWdt2

  With ActivePresentation.Slides(1)
    With .Shapes(1)
      myTop1 = .Top
      myLft1 = .Left
      myHgt1 = .Height
      myWdt1 = .Width
    End With

    With .Shapes(2)
      myTop2 = .Top
      myLft2 = .Left
      myHgt2 = .Height
      myWdt2 = .Width
    End With
  End With

  cnt = ActivePresentation.Slides.Count

  For i = 2 To cnt
    With ActivePresentation.Slides(i)
      With .Shapes(1)
        .Top = myTop1
        .Left = myLft1
        .Height = myHgt1
        .Width = myWdt1
      End With

      With .Shapes(2)
        .Top = myTop2
        .Left = myLft2
        .Height = myHgt2
        .Width = myWdt2
      End With
    End With
  Next
End Sub

こんな感じでまとめるとスッキリしますね。

失礼ながら、2003で試行してみましたが、
ご提示のコードできちんと動きます。

なので
> どこが悪いのか
具体的な指摘は出来かねるのですが・・

For i = 2 To cnt
  With ActivePresentation.Slides(i)
    .Select
    With .Shapes(2)
      .Select
      .Top = myTop1

として、ステップインで実行してみると原因が掴めるかもしれません。



余計なお世話かもしれませんが、

Sub 表サイズの統一()
Dim myTop1, myLft1, myHgt1, myWdt1, cnt, i, myTop2, myLft2, myHgt2, myWdt...続きを読む

QエクセルVBAで画像を貼り付ける座標設定方法は?

Sheets("Sheet1")に貼り付けたJ-pegの画像(=シンボルマーク)を別なシートに貼り付けるのは下記のVBAで出来ました。ただ、これでは貼り付け先のシートのセルK12が、貼り付け元のK12と同じ位置でないと思った場所に張り付きません。
そこでセルで場所を指定するのではなく、座標のようなもので指定する方法はないものかと考えた次第です。
オートシェイプなどは座標指定で作成できるのですが、J-pegのような画像はどうすればいいのでしょうか?

Sub TEST()
Sheets("FACE").Shapes("シンボルマーク").Copy
ActiveSheet.Range("K12").Select
ActiveSheet.Paste
End Sub

Aベストアンサー

#1です。
>この場合、ファイルをエクセルにくっつけて渡すなんてこと
>はできないものでしょうか?(別々にではなくあくまでエク
>セルのブックに付属した形で)
Excelのブックに付属した形にするなら、コピーペーストする方がいいと思います。一旦挿入した画像を別途保存するのは、簡単には出来ないと思います。

複数のシートで同じような作業をするなら、次のような方法も考えられます。
Function CpyMrk(MrkNM As String, myTop As Single, myLeft As Single)
Sheets("FACE").Shapes(MrkNM).Copy
ActiveSheet.Paste
ActiveSheet.Shapes(MrkNM).Top = myTop
ActiveSheet.Shapes(MrkNM).Left = myLeft
End Function

Sub test()
CpyMrk "シンボルマーク", 10, 10
End Sub

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Qパワーポイントで画像を一括挿入する方法について

パワーポイントに画像を一括で挿入したいと考えています。
ドラッグ&ドロップでは一つずつしか挿入できません。

良い方法を知っていれば教えてください。

よろしくお願いします。

Aベストアンサー

★マークのところはご自分で変えてください。

Sub 画像複数挿入2000_2()
Dim cntL As Integer, cntT As Integer
Dim flgAspect As Boolean
Dim SL As Single, SR As Single, ST As Single, SB As Single
Dim ML As Single, MT As Single
Dim xlApp As Object
Dim dlgOpen As Variant
Dim myPre As Presentation
Dim Sld As Slide
Dim n As Long
Dim i As Integer, j As Integer
Dim sldWidth As Single, sldHeight As Single
Dim realWidth As Single, realHeight As Single
Dim myWidth As Single, myHeight As Single
Dim myLeft As Single, myTop As Single
Dim myPic As Shape
cntL = 2 '★横方向枚数2~6などで変更
cntT = 1 '★縦方向枚数2~6などで変更
flgAspect = True '★縦横比を固定するときはTrue,しないときはFalseで変更
SL = 0 'スライド左余白
SR = 0 'スライド右余白
ST = 0 'スライド上余白
SB = 0 'スライド下余白
ML = 0 '左右間隔
MT = 0 '上下間隔

Set myPre = ActivePresentation
With myPre
sldHeight = .SlideMaster.Height
sldWidth = .SlideMaster.Width
End With
realWidth = sldWidth - SL - SR
realHeight = sldHeight - ST - SB
myWidth = realWidth / cntL - ML
myHeight = realHeight / cntT - MT
Set xlApp = CreateObject("Excel.Application")
dlgOpen = xlApp.GetOpenFileName("gif,*.gif,jpg,*.jpg,jpg,*.jpeg,bmp,*.bmp,png,*.png,wmf,*.wmf,tiff,*.tiff", , , , True)
With myPre.Slides '新規スライド
j = 1
i = 1
Set Sld = .Add(.Count + 1, ppLayoutBlank)
End With
If IsArray(dlgOpen) Then
For n = LBound(dlgOpen) To UBound(dlgOpen)
If i > cntT Then 'さらに新規スライド
i = 1
With myPre.Slides
Set Sld = .Add(.Count + 1, ppLayoutBlank)
End With
End If
myLeft = SL + (j - 1) * realWidth / cntL
myTop = ST + (i - 1) * realHeight / cntT
Set myPic = Sld.Shapes.AddPicture _
(FileName:=dlgOpen(n), _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=myLeft, Top:=myTop)
With myPic
.LockAspectRatio = flgAspect
.Height = myHeight
If flgAspect = False Then
.Width = myWidth
Else
If .Width > myWidth Then
.Width = myWidth
End If
End If
End With
If j < cntL Then '横にずらす
j = j + 1
Else '改行
j = 1
i = i + 1
End If
Next n
End If
xlApp.Quit
Set dlgOpen = Nothing
Set xlApp = Nothing
Set Sld = Nothing
Set myPre = Nothing
End Sub

★マークのところはご自分で変えてください。

Sub 画像複数挿入2000_2()
Dim cntL As Integer, cntT As Integer
Dim flgAspect As Boolean
Dim SL As Single, SR As Single, ST As Single, SB As Single
Dim ML As Single, MT As Single
Dim xlApp As Object
Dim dlgOpen As Variant
Dim myPre As Presentation
Dim Sld As Slide
Dim n As Long
Dim i As Integer, j As Integer
Dim sldWidth As Single, sldHeight As Single
Dim realWidth As Single, realHeight As Single
Dim myWidth As Single...続きを読む

QExcelマクロでグラフをPowerPointにリンク貼り付けする方法

グラフ作成後データが変更にされるケースがあるので、Powerpointにリンク貼り付けをしていますが、グラフ数が多いので作業短縮のためマクロ化を進めています。
Q&Aを参考に、PowerPointの起動・スライド追加まではできたのですが、PowerPointの読み取りマクロで得られたリンク貼り付けと思われる実行文で「実行エラー Selection.ShapeRange : 無効な要求です。適切な項目が選択されていません。」というエラーが発生し、お手上げの状態です。解決方法をご教授願います。

Set ppApp = CreateObject("PowerPoint.Application")
:
:
For Each Sh In ActiveWorkbook.Worksheets
For i = 1 To Sh.ChartObjects.Count
     '//対象グラフをコピー
    Sh.ChartObjects(i).Copy
    ' // PP 新規スライド挿入
    Set ppSld = ppPst.Slides.Add(Index:=i, _
    Layout:=ppLayoutBlank)
    ' // PP 貼り付け 
         ↓ここでエラー発生
    With ppApp.ActiveWindow.Selection.ShapeRange(i)
   .Height = 409.5
   .Width = 649.25
    End With
Next i
Next Sh

グラフ作成後データが変更にされるケースがあるので、Powerpointにリンク貼り付けをしていますが、グラフ数が多いので作業短縮のためマクロ化を進めています。
Q&Aを参考に、PowerPointの起動・スライド追加まではできたのですが、PowerPointの読み取りマクロで得られたリンク貼り付けと思われる実行文で「実行エラー Selection.ShapeRange : 無効な要求です。適切な項目が選択されていません。」というエラーが発生し、お手上げの状態です。解決方法をご教授願います。

Set ppApp = CreateObject("Powe...続きを読む

Aベストアンサー

[回答番号:No.1] の DOUGLAS_ です。

>リンク貼り付け・・・
>読み取りマクロで・・・
でしたね。
 [回答番号:No.1]は取り下げます。

 私もいろいろと WEB検索 してみて
ppApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoTrue
あたりでいけるかとも思ったのですが、どうも「クリップボード 経由の Excel グラフ」に見合う「DataType」がなさそうですし、大体、VBA の実行中には、PowerPoint 自体で、[形式を選択して貼り付け] - [リンク貼り付け] が グレイアウト して選択できない状態のようですので、ひょっとしたら、VBA で「リンク貼り付け」すること自体無理なのかも知れません。

 ちなみに、ppApp の方を AppActivate して
Application.SendKeys "%ES%L{ENTER}"
とでもしようかと思いましたが、これでも [リンク貼り付け(L)] が グレイアウト してます。

[回答番号:No.1] の DOUGLAS_ です。

>リンク貼り付け・・・
>読み取りマクロで・・・
でしたね。
 [回答番号:No.1]は取り下げます。

 私もいろいろと WEB検索 してみて
ppApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoTrue
あたりでいけるかとも思ったのですが、どうも「クリップボード 経由の Excel グラフ」に見合う「DataType」がなさそうですし、大体、VBA の実行中には、PowerPoint 自体で、[形式を選択して貼り付け] - [リンク貼り付け] が グレイアウト し...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング