生成AIでエクセルのマクロを作ってみたその２株式会社星組

右クリックで画像貼り付け改(直接貼付・自動起動)

前回、右クリックで画像貼り付けに、リンク貼り付けでなく直接貼付にして欲しい、マクロを自動起動して欲しいと要望がありましたので、予定を変更して右クリックで画像貼り付け改(直接貼付・自動起動)を作成しました。

マクロを作成する
1.開発タブを有効にする:
「ファイル」タブをクリックし、「オプション」を選択します。
「リボンのユーザー設定」を選択し、「開発」タブにチェックを入れて「OK」をクリックします。
2.Visual Basic for Applications (VBA) エディタを開く:
「開発」タブをクリックし、「Visual Basic」を選択します。
「挿入」→「標準モジュール」を選択します。
3.画像の貼り付けをリンクではなく直接貼り付けるには、Pictures.Insert メソッドではなく Shapes.AddPicture メソッドを使用します。
4.以下のようにコードを変更しコードをコピーして、モジュールに貼り付けます。

Sub InsertPictureInSelectedRange()
Dim ws As Worksheet
Dim pic As Shape
Dim picPath As String
Dim rng As Range
Dim fd As FileDialog
Dim imgWidth As Single, imgHeight As Single
Dim cellWidth As Single, cellHeight As Single
Dim aspectRatio As Single

' ファイルダイアログを表示して画像ファイルを選択
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Title = "画像ファイルを選択してください"
    .Filters.Add "画像ファイル", "*.jpg; *.jpeg; *.png; *.bmp; *.gif", 1
    If .Show = -1 Then
        picPath = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

' 選択されたセル範囲を取得
Set rng = Selection
If rng Is Nothing Then Exit Sub

' ワークシートを指定
Set ws = ActiveSheet

' セル範囲のサイズを取得
cellWidth = rng.Width
cellHeight = rng.Height

' 画像を挿入
Set pic = ws.Shapes.AddPicture(picPath, msoFalse, msoCTrue, rng.Left, rng.Top, -1, -1)

' 画像の元のサイズを取得
imgWidth = pic.Width
imgHeight = pic.Height
aspectRatio = imgWidth / imgHeight

' セル範囲に合わせて画像のサイズを調整
If cellWidth / cellHeight > aspectRatio Then
    pic.Width = cellHeight * aspectRatio
    pic.Height = cellHeight
Else
    pic.Width = cellWidth
    pic.Height = cellWidth / aspectRatio
End If

' 画像のサイズを98％に縮小
pic.Width = pic.Width * 0.998
pic.Height = pic.Height * 0.995

' 画像の位置をセル範囲に合わせる
With pic
    .Left = rng.Left + (cellWidth - pic.Width) / 2
    .Top = rng.Top + (cellHeight - pic.Height) / 2
End With

End Sub

マクロを自動実行させる
　保存したワークシートを開いたときに右クリックメニューに自動的に追加するためには、ワークシートが開かれたときに実行されるコードを追加する必要があります。これには、Workbook_Open イベントを使用します。

　1.Visual Basic for Applications (VBA) エディタを開く:
「開発」タブをクリックし、「Visual Basic」を選択します。
「ThisWorkbook」をダブルクリックしモジュールを開きます。
　2.以下のコードをコピーして、モジュールに貼り付けます。

Private Sub Workbook_Open()
Dim cb As CommandBar
Dim cbc As CommandBarControl

' 右クリックメニューを取得
Set cb = Application.CommandBars("Cell")

' 既存のメニューを削除
On Error Resume Next
cb.Controls("画像貼り付け").Delete
On Error GoTo 0

' 新しいメニューを追加
Set cbc = cb.Controls.Add(Type:=msoControlButton, Before:=1)
With cbc
    .Caption = "画像貼り付け"
    .OnAction = "InsertPictureInSelectedRange"
End With

End Sub

保存したワークシートを開いたときに、右クリックメニューに「画像貼り付け」が追加されます。

画像を直接貼り付けダウンロード