オートシェイプをWクリックしたらショートカットして図の選択画面になる様になりませんか

質問

こんにちは老人会新米会計役員　XP　エクセル2003です。
お年ですが少しはエクセルがわかります。
ばばあ部の通信販売の写真入カタログを作成していますが
写真挿入が多いので大変です。2日間OKで調べましたら
セルをダブルクリックすると図の選択画面が出るマクロが
紹介されていました。やってみたら大変便利ですが
オートシェイプへ写真を挿入すれば、大きさ又デザインが
自由になり非常に使いやすくなります。
しかしオートシェイプでは
四角形挿入→右クリ→書式設定→色と線→塗りつぶし
→塗りつぶし効果→図→選んで→挿入
→OKとものすごく手間がかかります。
そこでオートシェイプをダブルクリックしたら図の選択画面へ
ショートカットで行くような事はできませんか。
若手のばあさん（58歳）しかキーボードをさわれません。
でも簡単になれば教えられます。
宜しくお願いいいたします。

回答No.7

misatoanna · ベストアンサー

再度の追加訂正です。　　m(_ _)m

Pic = Application.GetOpenFilename(PicType, , _
　　　　　　　　　　　　　　　　"挿入する画像を選択", , False)
　　　↓
Pic = Application.GetOpenFilename(PicType, , TTL, , False)

タイトルを変数化したのですが、書き換え忘れしてしまいました。

回答No.6

misatoanna

ごめんなさい。私の書き込みミスです。

最初のモジュール（Sub FillPic）の一部、

PicType = "画像ファイル,*.jpg;*.bmp;*.png;*.gif," & _
　　　　　　"jpgファイル,*.jpg,bmpファイル,*.bmp,pngファイル, _
　　　　　　　*.png,gifファイル,*.gif"

の部分を

PicType = "画像ファイル,*.jpg;*.bmp;*.png;*.gif," & _
　　　　　　"jpgファイル,*.jpg,bmpファイル,*.bmp,pngファイル," & _
　　　　　　"*.png,gifファイル,*.gif"

に書き換えてください。

長過ぎると思って改行したのですが、テキストエディタ上で操作したため
気づきませんでした。　　　(^^ゞ

お礼

できました～～　ありがとうございました。
おとといもその前も、昨日の夜も延べ60時間ぐらい過去ログを
見てましたが、同じ内容はありませんでした。
昨日子供が仕事から帰ってきてこれができれば、自由にハート型
などにくりぬいてアルバム、
（卒業アルバムでの欠席写真も簡単にできます。）
又カタログ、工事写真帳、住宅間取り写真、図面をスキャンして、
家具、　照明器具などの配置図、
もうなんか用途いっぱいです。画像も重ねられ、文字も入れられ
まだまだ用途いっぱいありそうですね。
写真の大きさに関係なくオートシェイプの
大きさで張り付く所がいいです。
しかもエクセルなのでみんなにあげられます。←これがいい！！
何回も本当にありがとうございました。
早速ばばあ部のカタログと、
先日のお葬式の写真アルバムを作ります。
ばばあ部又爺さん部もありますので
これからお葬式の写真用が多くなると思います。
ありがとうございました。
このマクロで作成したエクセルには白文字でmisatoannaさんの
名前を入れさせていただきます。どこかでお会いするかも
しれませんね　本等にありがとうございました。m(._.)m

回答No.5

misatoanna

ダブルクリックでなく、オートシェイプ上の右クリックから操作する
案です。
どうしてもダブルクリックがよい場合は、無視してください。

標準モジュールに以下をすべてコピペし、いったんブックを保存して
閉じ、その後改めて開くと、「そのブックに限って」オートシェイプ
の右クリックメニューに「画像を挿入」が表示されるようになります。

Sub FillPic()
　Dim Pic
　Dim TTL, PicType
　TTL = "挿入する画像を選択"
　PicType = "画像ファイル,*.jpg;*.bmp;*.png;*.gif," & _
　　　　　　"jpgファイル,*.jpg,bmpファイル,*.bmp,pngファイル, _
　　　　　　　*.png,gifファイル,*.gif"
　Pic = Application.GetOpenFilename(PicType, , _
　　　　　　　　　　　　　　　　"挿入する画像を選択", , False)
　On Error GoTo Er
　Selection.ShapeRange.Fill.UserPicture Pic
Er: On Error GoTo 0
End Sub

Sub Auto_Open()　'シェイプの右クリックメニューにマクロを追加
　Dim NewItem
　Set NewItem = Application.CommandBars("Shapes").Controls.Add _
　　　　　　　　(Type:=msoControlButton)
　With NewItem
　　.Caption = "画像を挿入"　　'メニュー表記名
　　.OnAction = "FillPic"　　　'実行マクロ名
　　.FaceId = 748　　　　　　　'アイコン番号（748は無地）
　End With
　Set NewItem = Nothing
End Sub

Sub Auto_Close()　'シェイプの右クリックメニューをリセット
　Application.CommandBars("Shapes").Reset
End Sub

お礼

何回もご回答ありがとうございます。
私の操作が悪いのか
新しいBOOKに全部貼り付けて保存してBOOKを閉じ
立ち上げてマクロを有効にして、オートシェイプを作成し右クリック
しましたが、右クリックメニューには画像を挿入
は追加されていません。お手数をおかけいたします
どこか私の操作が間違っていると思いますので
操作手順を詳しく教えてください、
宜しくお願いいいたします。

補足

こんばんは何回もすみません。
右クリックで挿入は表示されましたが
実行すると　コンパイルエラー表示がでました

　PicType = "画像ファイル,*.jpg;*.bmp;*.png;*.gif," & _
　　　　　　"jpgファイル,*.jpg,bmpファイル,*.bmp,pngファイル, _
　　　　　　　*.png,gifファイル,*.gif"
の所がエラーらしく赤文字で表示されました
なんかいもすみません

回答No.4

ookami1969

そういうショートカットは存じませんが
メニューバーの「挿入」→「図」→「ファイルから」
で同じ画面が出て来ますよ？

回答No.3

marbin

レスが入れ違いになりました。
私が＃2で提示したコードは、クリックしたシェイプの塗りつぶしに
選択した画像を設定するものです。

シートに画像を挿入する場合は、
挿入→図→ファイルから
をマクロの自動記録したら参考になるコードが出来ます。
自動記録で出来たコードのファイルパスの部分にGetOpenFileName
で取得したファイルパスを代入してやります。
文字列ではなく、変数で指定してやります。

回答No.2

marbin

サンプルコードです。

Dim sp As Shape
Dim Pic As Variant
Dim F As Variant
Set sp = ActiveSheet.Shapes(Application.Caller)
　Pic = Application.GetOpenFilename("JPGファイル(*.jpg),*.jpg,全てのファイル(*.*),*.*", _
Title:="画像選択", MultiSelect:=False)
If TypeName(Pic) = "Boolean" Then Exit Sub
With sp
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = msoLineSolid
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 64
.Line.BackColor.RGB = RGB(255, 255, 255)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.BackColor.RGB = RGB(255, 255, 255)
.Fill.UserPicture Pic
End With

補足

こんばんわ何回もご回答ありがとうございます。
教えていただいたサンプルコードでできましたが、
マクロ登録が　クリックしかできません
クリックだとオートシェイプをクリックするたび写真
張り付きマクロになり移動や大きさの調整ができません
何か他の動作登録はできますでしょうか？
クリック3回はしてみましたがダメでした、
コントロール+エンターもしてみましたが
登録に何かコツがあるのでしょうか
宜しくお願いいいたします。

回答No.1

marbin

シェイプにはマクロを登録できます。
シェイプを右クリックで出てくるメニューの
「マクロの登録」で登録したいマクロを選択します。

でシェイプを"クリック"したら登録したマクロが動作します。
また、↓のようにマクロを呼び出したシェイプの名前の取得も可能です。

Sub test()
MsgBox ActiveSheet.Shapes(Application.Caller).Name
End Sub

ファイルの選択は
Application.GetOpenFilename
が便利です。
フォルダを指定することも可能です。

Dim Pic As Variant
Dim F As Variant
Pic = Application.GetOpenFilename("JPGファイル(*.jpg),*.jpg,全てのファイル(*.*),*.*", _
Title:="画像選択", MultiSelect:=False)
If TypeName(Pic) = "Boolean" Then Exit Sub
MsgBox Pic

補足

早速のご回答ありがとうございます。
Dim Pic As Variant
Dim F As Variant
Pic = Application.GetOpenFilename("JPGファイル(*.jpg),*.jpg,全てのファイル(*.*),*.*", _
Title:="画像選択", MultiSelect:=False)
If TypeName(Pic) = "Boolean" Then Exit Sub
MsgBox Pic
を貼り付けたら図の選択画面に行きました、
ファイルを選択しましたが挿入が上手くいきません。
写真（ｊｐｇ）を選択したら挿入じゃなく　開く　が出て
開いたら　写真のある場所の表示が出てOKを押しても
変化がありません。宜しくお願いいいたします。