Excelのセル内に写真を手軽に挿入したい

セル内に「写真を挿入」というボタンを配置して
写真が自動的にリサイズされてセル内に収まるようにしたいです。
参考になる方法やURLを貼ってもらえると助かります！

No.2 ベストアンサー 回答者： rukaandkaito 回答日時： 2019/07/02 11:53

あっ！ごめんなさい

エラー処理を忘れてました
--------------------------------------------------------------------------------
Public Sub Sample(intR As Integer)

Dim myFile As Variant

myFile = Application.GetOpenFilename()

If VarType(myFile) = vbBoolean Then
Else
ActiveSheet.Cells(intR, 1).Select
With ActiveSheet.Pictures.Insert(myFile)
.Width = ActiveSheet.Cells(intR, 1).Width
.Height = ActiveSheet.Cells(intR, 1).Height
End With
End If

End Sub
--------------------------------------------------------------------------------
If以下の構文をElse内に入れてください(;´･ω･)

この回答へのお礼

非常に丁寧な回答ありがとうございます！
当方マクロをやった事がないので
これを足掛かりに勉強します。
rukaandkaito様の回答は自分が求めていた
回答そのものです！
お礼の返答が遅くなり大変申し訳ないです；
本当にありがとうございます！

お礼日時：2019/08/09 18:51

No.4 回答者： ママチャリ 回答日時： 2019/07/06 11:11

「写真を挿入」ボタンを配置するのって、面倒くさくないですか？

例えば、Worksheet_BeforeRightClickイベントプロシジャに、次のマクロをコーディングします。
写真を挿入したい複数のセルに、普通の文字列で「写真を挿入」と入力しておきます。
そうすると、該当セルを右クリックすることにより「図の挿入」ウィンドウが表示されるようになります。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.CountLarge = 1 And Target(1).Value = "写真を挿入" Then
Cancel = True
With Application.Dialogs(xlDialogInsertPicture)
If .Show = -1 Then Selection.ShapeRange.Width = Target.Width
End With
End If
End Sub

この回答へのお礼

知恵を貸していただきありがとうございます！
今の今までお礼の返答ができておらず心苦しい限りです。
ママチャリ様の提示していただいた方法も視野に入れて
やってみたいと思います！
ありがとうございます！

お礼日時：2019/08/09 19:03

No.3 回答者： tom04 回答日時： 2019/07/02 14:07

こんにちは！

お望みの方法でないと思いますが・・・安直なやり方です。

オートシェイプの四角形を好みの大きさに挿入しておきます（「枠線なし」がいいかも・・・）
あとはオートシェイプ上でダブルクリック　→　図形の塗りつぶし　→　図　→　好みの画像を選択！

これでオートシェイプ内に画像が収まります。m(_ _)m

この回答へのお礼

目からウロコが落ちるようなやりかたですね( ﾟДﾟ)！
マクロを組まないと出来ないと思っていた作業ですが
これなら簡単に出来そうです＾＾
お礼の返答が遅くなり大変申し訳ないです。
知恵を貸して頂きありがとうございます！

お礼日時：2019/08/09 18:54

No.1 回答者： rukaandkaito 回答日時： 2019/07/02 11:48

ではまず、対象のセルにActiveXのボタンを貼り付けましょう

ボタンをダブルクリックしコードには対象の行番号を引数にサブルーチンを呼び出します
以下ワークシートと標準モジュールにそれぞれ記載してください。標準モジュールのほうはそのままコピペで構いませんが、ボタンの方は対象の座標（行位置）を必ず指定してください。

Sheet1(Sheet1)
--------------------------------------------------------------------------------
Private Sub cmd01_Click()
Call Sample(2)
End Sub

Private Sub cmd02_Click()
Call Sample(5)
End Sub
--------------------------------------------------------------------------------
Module1
--------------------------------------------------------------------------------
Public Sub Sample(intR As Integer)

Dim myFile As Variant

myFile = Application.GetOpenFilename()

If VarType(myFile) = vbBoolean Then
Else
End If
ActiveSheet.Cells(intR, 1).Select
With ActiveSheet.Pictures.Insert(myFile)
.Width = ActiveSheet.Cells(intR, 1).Width
.Height = ActiveSheet.Cells(intR, 1).Height
End With

End Sub
--------------------------------------------------------------------------------
お試しください