[ホーム] ＞ [VBScript FAQ 一覧] ＞ [Excel でダブルクリックで画像を張り付ける (ファイル埋め込み) サンプルコード]

Excel でダブルクリックで画像を張り付ける (ファイル埋め込み) サンプルコード | VBScript / VBA FAQ

Excel でセルをダブルクリックしてそのセルにぴったりサイズの画像を埋め込むサンプルを紹介します。
Excel への画像埋め込みには以下の2通りがあると思います。

(1)画像のリンクをExcelに埋め込み (Excelのサイズは増えない)
(2)画像ファイルそのものの埋め込み (Excelのサイズが増える)

このページでは(2)の方法に関して説明します。

insert メソッドでは埋め込みできない

リンクされたイメージを表示できません。ファイルが移動または削除されたか、名前が変更された可能性があります。

リンクに正しいファイル名と場所が指定されていることを確認してください。

サンプル========================================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

Dim pic01 As Variant
Dim spc01 As Object

pic01 = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像を選択してください", , False)
If pic01 = False Then
MsgBox "【エラー】画像の確認に失敗しました。画像が選択されていない、アクセス権がない、不正なファイルなどが考えれます。"
Exit Sub
End If



Set spc01 = (ActiveSheet.Shapes.AddPicture(Filename:=pic01, LinkToFile:=False, SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, Width:=0, Height:=0))

spc01.LockAspectRatio = msoTrue

spc01.ScaleHeight 1, msoTrue
spc01.ScaleWidth 1, msoTrue


spc01.Width = Target.Width
If spc01.Height > Target.Height Then

spc01.Height = Target.Height
spc01.Left = Target.Left + (Target.Width - spc01.Width) / 2

Else

spc01.Top = Target.Top + (Target.Height - spc01.Height) / 2

End If

Set spc01 = Nothing
End Sub


================================================

[ホーム] ＞ [VBScript FAQ 一覧]