アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

--------------------
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"は見つからないというエラーが出てしまう。


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

A 回答 (3件)

1、位置に関して・・・単に縦横を逆に設定しているだけでしょう。


.Top = picPos_yoko
.Left = picPos_tate

2、「名前」は変更できないみたいです。
表は非常にたくさんのオブジェクトがグループ化されたものとして
扱われています。
どうしても名前を付け替えるなら
図として張り付ければ可能でしょう。

  貼り付ける場合は必ず最後のshapeになるのでこのようにcountを使うことで名前を取得できます。
   .Shapes(.Shapes.Count).Name
    • good
    • 0
この回答へのお礼

1.これは記述を間違って逆にしてしまいました。誤解を与えてすみませんでした。m__m

2.なるほど図として貼り付けたところうまくいきました。ありがとうございます。

お礼日時:2009/08/05 19:59

Pasteメソッドが返すShapeRangeオブジェクトはあまり


あてにならないので、すぐには使わず、
いったんSlide.Shapesプロパティから貼り付けたオブジェクトを取得、
名前を設定としてみてください。もしかしたらうまくいくかもしれません。

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


※バージョンが違うとだめな場合があります。
例えばPPT2007の場合は
 pptApp.ActiveWindow.View.Paste
 With pptPre.Slides(page).Shapes
  With .Item(.Count)
   .Name = "hyou1"
   .Top = picPos_tate
   .Left = picPos_yoko
  End With
 End With
    • good
    • 0
この回答へのお礼

今更ながらではございますが、その後VBAの腕も上達して、社内のマクロ担当になっております。ありがとうございました。

お礼日時:2012/03/24 18:46

書き忘れました。


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

 With pptPre.Slides(page).Shapes
  .Paste
  With .Item(.Count)
   .Name = "hyou1"
   .Top = picPos_tate
   .Left = picPos_yoko
   MsgBox "オブジェクト名: " & .Name
  End With
 End With
    • good
    • 1
この回答へのお礼

貼り付け位置を調整することができました。ありがとうございました。なるほどこういう手があったのかと関心しました。

お礼日時:2009/08/05 20:00

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