[[20210615164838]]　『画像挿入をしたい』（Jrq）　ページの最後に飛ぶ

『画像挿入をしたい』（Jrq）

セルクリック時自動で図の挿入をし、セルの大きさに合わせてサイズが変更するような仕組みは可能でしょうか。
よろしくお願いいたします。

＜使用 Excel：Office365、使用 OS：Windows10 ＞

 マクロを使えば可能だと思います。

 >自動で図の挿入をし

 貼り付ける図は事前に決まっているのでしょうか？
（通りすがり） 2021/06/15(火) 17:02

ありがとうございます。
図というか写真などです。
拾い物ですが、

Public Sub imgpast()

    Dim uFil As FileDialog
    Dim uCel As Range
    Dim uCelW, uCelH As Single

    ' 貼り付けセルの大きさ
    Set uCel = ActiveCell
        uCelW = uCel.Width
        uCelH = uCel.Height
    Set uCel = Nothing

    ' 貼り付ける画像の選択
    Set uFil = Application.FileDialog(msoFileDialogFilePicker)

    With uFil
        .AllowMultiSelect = False
        With .Filters
            .Clear
            .Add "画像ファイル", "*.jpg; *.gif; *.png", 1
        End With
    End With

    If uFil.Show Then
        ActiveSheet.Pictures.Insert(uFil.SelectedItems(1)).Select
        With Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Width = uCelW
            .Height = uCelH
        End With
    End If

    Set uFil = Nothing

End Sub

↑これで今マクロオプションでショートカットキーを作成し画像挿入をしていますが、
セルに画像挿入と入力し、そのセルをクリックすると図の挿入フォルダ？を立ち上げたいです。
説明がうまくなくてすいません。

（Jrq） 2021/06/15(火) 19:09

        With Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Width = uCelW
            .Height = uCelH
        End With

↓貼り付け位置指定を追加

        With Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Top = uCel.Top
            .Left = uCel.Left
            .Width = uCelW
            .Height = uCelH
        End With

そのセルをクリックすると

シートモジュールのイベントにはクリックイベントはないので
右クリックで代用

シートモジュールに↓を記述

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

 If Target.Value <> "画像挿入" Then Exit Sub
 Cancel = True
 Call imgpast
End Sub
（通りすがり） 2021/06/15(火) 19:59

Set uCel = Nothing

これはプロシージャの最後に移動しておいてください。
（通りすがり） 2021/06/15(火) 20:00

ありがとうございます。
これでよろしいですか？

Public Sub imgpast()

    Dim uFil As FileDialog
    Dim uCel As Range
    Dim uCelW, uCelH As Single

    ' 貼り付けセルの大きさ
    Set uCel = ActiveCell
        uCelW = uCel.Width
        uCelH = uCel.Height

    ' 貼り付ける画像の選択
    Set uFil = Application.FileDialog(msoFileDialogFilePicker)

    With uFil
        .AllowMultiSelect = False
        With .Filters
            .Clear
            .Add "画像ファイル", "*.jpg; *.gif; *.png", 1
        End With
    End With

    If uFil.Show Then
        ActiveSheet.Pictures.Insert(uFil.SelectedItems(1)).Select
          With Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Top = uCel.Top
            .Left = uCel.Left
            .Width = uCelW
            .Height = uCelH
        End With
    End If

    Set uFil = Nothing
    Set uCel = Nothing
End Sub
（Jrq） 2021/06/15(火) 20:17

 それで問題ないです。
 少し手を加えてみました。一部抜粋です。

 '変数宣言
Dim mypic As Picture

   If uFil.Show Then
        'Selectを使わない方法に変更
        Set mypic = ActiveSheet.Pictures.Insert(uFil.SelectedItems(1))
          With ActiveSheet.Shapes(mypic.Name)
            .LockAspectRatio = msoFalse
            .Top = uCel.Top
            .Left = uCel.Left
            .Width = uCelW
            .Height = uCelH
        End With
    End If

　’変数の開放
　Set mypic = Nothing
（通りすがり） 2021/06/15(火) 20:25

すいません。
右クリックで開かないのですが何かまちがいがありますでしょうか。
すいません。
現在、seat１のGeneral、imgpastの中に入れています。

ありがとうございます。
上記の分はどこに入れればいいのでしょうか。
（Jrq） 2021/06/15(火) 20:28

 Public Sub imgpast() 
 これは標準モジュールのままでいいです。

 シートモジュールに↓を記述します。
http://officetanaka.net/excel/vba/beginner/10.htm
 ※セルに「画像挿入」と入力されてないと作動しません。

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 
  If Target.Value <> "画像挿入" Then Exit Sub
  Cancel = True
  Call imgpast
 End Sub

 >Dim uCelW, uCelH As Single

 ↓の方がいいですね。
 Dim uCelW As Single, uCelH As Single

 でないと↓のように宣言したのと同じことになってしまいます。
 エラーにはならないですが。

 Dim uCelW As Variant, uCelH As Single
（通りすがり） 2021/06/15(火) 20:34

できました。
ありがとうございます！！
理想は左クリックでしたが想像通りです。
お忙しい中申し訳ございません。
助かりました！！
（Jrq） 2021/06/15(火) 20:43

 ↑のリンクにはシートモジュールについては言及されてませんでした。
 シートモジュールの表示方法です。

 シートタブを右クリック
 ↓
 コードの表示

 または

 Alt+F11
 でVBE表示
 左側のウィンドウの該当のシートをWクリック
（通りすがり） 2021/06/15(火) 20:43

シートのイベントプロシージャに直接コードを書くとこんな感じです

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

   Dim uFil As FileDialog
   Dim uCel As Range
   Dim uCelW As Single, uCelH As Single
   Dim uCelT As Single, uCelL As Single
   Dim mypic As Picture

     If Target.Value <> "画像挿入" Then Exit Sub
     Cancel = True

     ' 貼り付けセルの大きさ
     Set uCel = Target
     uCelW = uCel.Width
     uCelH = uCel.Height
     uCelT = uCel.Top
     uCelL = uCel.Left

     ' 貼り付ける画像の選択
     Set uFil = Application.FileDialog(msoFileDialogFilePicker)

     With uFil
       .AllowMultiSelect = False
        With .Filters
            .Clear
            .Add "画像ファイル", "*.jpg; *.gif; *.png", 1
        End With
     End With

    If uFil.Show Then
       Set mypic = ActiveSheet.Pictures.Insert(uFil.SelectedItems(1))
       With ActiveSheet.Shapes(mypic.Name)
         .LockAspectRatio = msoFalse
         .Top = uCelT
         .Left = uCelL
         .Width = uCelW
         .Height = uCelH
      End With
    End If

    Set uFil = Nothing
    Set uCel = Nothing
    Set mypic = Nothing
End Sub
（通りすがり） 2021/06/15(火) 20:53

コメント返信：

[ 一覧(最新更新順) ]

[[20210615164838]] 『画像挿入をしたい』（Jrq） ページの最後に飛ぶ

[[20210615164838]]　『画像挿入をしたい』（Jrq）　ページの最後に飛ぶ