エクセルのシートに貼りつけたbmpをjpeｇに

質問

手持ちの本（4冊）やインターネットで探せなかったので、教えてください。

エクセルのシートに15枚の画像（bitmap）が貼られており

このままではファイルが重いので、同サイズのjpegに変換したいのですが・・・

手でやると　画像選択→切り取り→貼り付けセルを選択→型式を選択して貼り付け→図（jpeg）

以下マクロの記録

ActiveSheet.Shapes.Range(Array("図 11")).Select
Selection.Cut
Range("H60").Select
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:= _
False
End Sub

となります。

これをVBAで数10ファイル連続で実行したいのですが、1つ問題があります。

画像はカウント後に配列で取り込み順次処理していきますが、

同じ場所に同じ大きさで貼りたいのですが、元画像を貼り付けているセルの番地の

取得をどうしたらよいか悩んでいます 　コレ → Range("H60").Select

画像が張り付いているセルは複数で左上のセルを選択して貼り付けしたいのですが・・・

貼り付けた画像（bitmap）は名前が自動的に振られているのでセルを指定して貼り付けると

元の位置に貼られない可能性があるので・・・

貼り間違いなどで、同じ位置でも図の名前（図11等）が違ってしまっている場合

説明が下手で申し訳ありませんが、ご存知の方よろしくお願いいたします。

回答No.1

mitarashi · ベストアンサー

こんなところでいかがでしょうか。xl2010で（少しだけ）試しています。
ご参考まで。
Sub test()
Dim shp As Shape
Dim sh As Worksheet
Dim shpAddress As String

Set sh = ActiveSheet
For Each shp In sh.Shapes
If shp.Type = msoPicture Then
shpAddress = shp.TopLeftCell.Address
shp.Cut
sh.Range(shpAddress).Activate
sh.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
End If
Next shp
End Sub

お礼

お忙しいところ誠にすみません。
年1、2回くらいしかマクロをやらないので、
基本的なところも忘れているので、大変助かります。
早速、連続処理のマクロに移植して動かしてみたいと思います。
大変ありがとうございました。