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

質問

パワーポイントVBAに貼付けた複数のグラフサイズを統一したいと思っています。
1～20枚目のスライドに、それぞれ２つのグラフが貼付けてあります。
全てのグラフサイズ・位置を統一したいと思い、以下の様な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
----------
各スライドにある１つ目のグラフのサイズは統一出来たのですが、２枚目のグラフは何の変化もおきません。

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

回答No.1

tsubuyuki · ベストアンサー

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

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

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

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

お礼

早速ご回答頂き有り難うございました！
お礼が遅くなり失礼しました汗

再度トライしてみましたが、何故かVBAは働いてくれませんでした。
もしかすると2007を使っているからかもしれませんが、不思議です。
デバッグしてみると、以下の様になりました。
----------
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

エラーメッセージ：
Shapes(不明なメンバー）：範囲外の整数２は次の有効な範囲にありません：１から１へ
----------

いずれにせよご回答頂き有り難うございました！
綺麗なコードもご紹介頂き、大変勉強になります。

お手数をおかけしました。

回答No.3

tsubuyuki

> "shape (不明なメンバー)：無効な要求です。図形を選択するには、表示がアクティブでなければいけません"
> とのエラーメッセージが帰ってきました。

>> ActivePresentation.Slides(2).Shapes(2).Select

とりあえず・・２枚目のスライドを表示させた状態で動かしましたか？と言うのが確認です。

これで選択できないという事は、
思惑の「グラフが二つ目のShapes」ではない、という事が考えやすいです。
※意味は２通り
　１）もしかしたら、グラフが「Shapeとして認識されていない」パターン
　　　２ページ目の二つ目のグラフの大きさを変える動作をマクロに記録し、
　　　ソレで確認するとはっきりします。
　　　例えば、こんな記録が残ります。
　　　　ActiveWindow.Selection.SlideRange.Shapes("Picture 22").Select
　　　　　　With ActiveWindow.Selection.ShapeRange
　　　　　　　　.ScaleWidth 0.75, msoFalse, msoScaleFromBottomRight
　　　　　　　　.ScaleHeight 0.67, msoFalse, msoScaleFromBottomRight
　　　　　　End With

　２）「二つ目のShape」が別のShapeであるパターン
　　　一つ目のグラフを選択した状態にして、キーボードのＴａｂキーを押すと
　　　二つ目のグラフが選択された状態になって欲しいです。
　　　これがグラフではなく他のモノにカーソルが飛んでいくなら、
　　　グラフの間に別の何かが挟まっているという事ですね。
　　　　Sub test()
　　　　　　For i = 1 To ActivePresentation.Slides(2).Shapes.Count
　　　　　　　　Debug.Print ActivePresentation.Slides(2).Shapes(i).Name
　　　　　　Next
　　　　End Sub
　　　こんな感じで名前を書きだしていくと、何かわかるかもしれません。

そして、残念な報告です・・
２０１０でもご提示のコードで動いてしまいました・・
２００７だけ動かないと言うのもおかしな話ですが・・
力及ばず、申し訳ありません。
傾向と対策が見つかることを祈っております。

お礼

何度もご回答頂き本当に有り難うございます。

>１）もしかしたら、グラフが「Shapeとして認識されていない」パターン
パワーポイント2007では、ご存知の通りマクロの記録機能が削除されてしまっております。
手元のPCでは確認出来ないのですが、何か機会を見つけて確認してみようと思います。

>２）「二つ目のShape」が別のShapeであるパターン
tabをクリックしたところ、見事二つ目のグラフに飛んでくれました。
余計な文字やグラフを全て削除して、シンプルなファイルを作って実験してみたのですが、
それでも動いてくれませんでした。

これだけ色々とご指導頂いたにも関わらず、解決のご報告を差し上げられず、申し訳ありません。
もしかすると、mac book air上の仮想ソフト(virtual box)で作業を行っているから悪かったのかも
しれません。

いずれにせよ、貴重なお時間を頂き有り難うございました！
心より感謝申し上げます。

回答No.2

tsubuyuki

> ２枚目のグラフは何の変化もおきません。

> エラーメッセージ：
> Shapes(不明なメンバー）：範囲外の整数２は次の有効な範囲にありません：１から１へ
> ----------

すいません、確認ですが・・

２枚目のスライドを表示しておいて、

Sub Test()
　　ActivePresentation.Slides(2).Shapes(2).Select
End Sub

これを実行すると、思惑の「二つ目のグラフ」が選択された状態になりますか？

お礼

何度も回答ありがとうございます！
エラー箇所を特定して頂きありがとうございました！

ご指摘の通り、Testマクロを組みましたが、
"shape (不明なメンバー)：無効な要求です。図形を選択するには、表示がアクティブでなければいけません"
とのエラーメッセージが帰ってきました。

現在作っているファイルについて、特異な現象なのかと思い、新しくファイルを作り直して実験してみましたが、
やはり同様のエラーメッセージになります。

ググってみたのですが原因が分からず…
http://social.msdn.microsoft.com/Forums/en-US/isvvba/thread/475ebd57-ace6-4705-b2b5-75addb5c2ccd/
同様の悩みを抱えた人は見つけたのですが、ここで提示されている解決方法（Select しないで単にActiveにする）を
試しても、やはり動きませんでした。

何度もお答え頂き恐縮なのですが、理由など分かればお教え頂けませんでしょうか？？
よろしくお願い致します。

なお、マクロを使って修正しようとしていた資料は、力技で（手作業で）完成させてしまいました。
もしも原因不明であれば、その旨一言書いて頂ければと思います。