マクロで写真挿入とサイズ変更

[mito]

Excel2007　を使用しています。
マクロで、下記の事を行いたい。
エクセルに　デジカメで撮った写真を挿入（JPG)、図（写真）のサイズ変更

順序は逆でも構いません。

方法1＞
図の縮小
（JPGをペイントで変形→サイズ変更→水平方向30%、垂直方向30%）
これをエクセルに貼り付ける

方法2＞
図を挿入後、サイズ変更
（サイズとプロパティ→拡大・縮小→縦横比を固定して30%）

記憶マクロでやってみたのですが、挿入などの操作が記憶されていません。
また、コピー元の図、コピー先のファイルは都度変わります。
コピー先のファイルは、増える予定なので、
できればマクロ専用のエクセルファイルを作成し、コピー先のファイルには
マクロが登録されてない方が良いのですが。

コピー元
Application.Dialogs(xlDialogOpen).Show
などを使って都度指定したい。

コピー先も、都度ファイルと貼り付ける位置を指定できますか？

よろしくお願いいたします。

[F]

こんにちは　Fです

Excel2000ですが、こんなんでは？
（ActiceSheetのActiveCellに挿入）

Sub InsertJPG()
Dim FilePath As Variant
FilePath = Application.GetOpenFilename(",*.jpg")
If Not FilePath = False Then
ActiveSheet.Pictures.Insert(FilePath).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = Selection.ShapeRange.Width * 0.3
End If
End Sub

[mito]

F様
さっそくご返事いただきありがとうございます。

ActiceSheetのActiveCellに挿入
に関して質問させて下さい。

マクロを実行すると、1枚目の写真を挿入後、2枚目を挿入すると
1枚目の上に重なって貼り付けられます。
A4に3枚写真を貼るのですが、目的の位置に的確に貼り付け、
移動させる手間を省きたいのです。
アクティブセルを写真の左上として、都度貼り付けたい場所に貼り付る事は可能でしょうか？

よろしくお願いいたします。

[F]

こんにちは　Fです

> マクロを実行すると、1枚目の写真を挿入後、2枚目を挿入すると
> 1枚目の上に重なって貼り付けられます。
> A4に3枚写真を貼るのですが、目的の位置に的確に貼り付け、
> 移動させる手間を省きたいのです。
> アクティブセルを写真の左上として、都度貼り付けたい場所に貼り付る事は可能でしょうか？

下にオフセットすれば良いのでは．．．こんなんでは？

Sub InsertJPG()
Dim FilePath As Variant
FilePath = Application.GetOpenFilename(",*.jpg")
If Not FilePath = False Then
ActiveSheet.Pictures.Insert(FilePath).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = Selection.ShapeRange.Width * 0.3
End If

ActiveCell.Offset(10, 0).Select

End Sub

[mito]

F様
回答ありがとうございます。
度々質問して申し訳ありません。

写真を張り付けた後のアクティブセルは、下にオフセットされるのですが
写真自体は同じ位置に重なって貼り付けられます。

写真を貼り付けたい位置は都度違います。その為
自動で決まった位置までアクティブセルを移動させるのではなく、
任意のセルを選択した後、マクロを実行すると
そのセルに写真が貼り付けられる様にできないでしょうか？

例えば、
1枚目の写真貼り付け位置　A1
2枚目の写真貼り付け位置　B15
3枚目の写真貼り付け位置　A30
これを、続けます

ActiveSheet.Pictures.Insert(FilePath).Select
この部分は、アクティブシートに貼られるという意味で、
アクティブシート上のアクティブセルではないのでしょうか？

よろしくお願いいたします。

[F]

こんにちは　Fです

> 写真を張り付けた後のアクティブセルは、下にオフセットされるのですが
> 写真自体は同じ位置に重なって貼り付けられます。
>
> 写真を貼り付けたい位置は都度違います。その為
> 自動で決まった位置までアクティブセルを移動させるのではなく、
> 任意のセルを選択した後、マクロを実行すると
> そのセルに写真が貼り付けられる様にできないでしょうか？
>
> 例えば、
> 1枚目の写真貼り付け位置　A1
> 2枚目の写真貼り付け位置　B15
> 3枚目の写真貼り付け位置　A30
> これを、続けます
>
> ActiveSheet.Pictures.Insert(FilePath).Select
> この部分は、アクティブシートに貼られるという意味で、
> アクティブシート上のアクティブセルではないのでしょうか？

私の環境はExcel2000ですので．．．
写真を挿入した時にアクティブセルの左上に移動させる
こんなんでは？

Sub InsertJPG()
Dim FilePath As Variant
FilePath = Application.GetOpenFilename(",*.jpg")
If Not FilePath = False Then
ActiveSheet.Pictures.Insert(FilePath).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = Selection.ShapeRange.Width * 0.3

Selection.ShapeRange.Left = ActiveCell.Left
Selection.ShapeRange.Top = ActiveCell.Top
End If
End Sub

[mito]

F様

有難うございます。

まさしく私のやりたいものが出来ました！！！
本当に助かりました。