| |
シート上に配置した任意の画像ファイルをクリックすると、
ユーザーフォームを出してImageコントロールに画像を表示するマクロです。
Ap_Picを実行し、配置したい複数のファイルを、出てきたダイアログ上で
Ctrlキーを押しながら選択して下さい。
アクティブシート上で"15行×7列分"のサイズにして、縦に順番に並べていきます。
Sub Ap_Pic()
Dim i As Long
Dim Tp As Single, Wp As Single, Hp As Single
Dim MyF As Variant, Pic As Variant
ChDir "C:\Temp" '←画像ファイルを保存しているフォルダーのパスに変更
With Application
MyF = .GetOpenFilename("画像ファイル(*.jpg),*.jpg", _
, , , True)
If VarType(MyF) = 11 Then GoTo ELine
.ScreenUpdating = False
End With
i = 1
For Each Pic In MyF
With Cells(i, 1).Resize(15, 7)
Tp = .Top: Wp = .Width: Hp = .Height
End With
With ActiveSheet.Pictures.Insert(Pic)
.Left = 0: .Top = Tp
.Width = Wp: .Height = Hp
.ShapeRange.AlternativeText = Pic
End With
i = i + 15
Next
ActiveSheet.Pictures.OnAction = "SetUF"
ELine:
With Application
ChDir .DefaultFilePath
.ScreenUpdating = True
End With
End Sub
↓こちらは、画像に登録して呼び出し専用とするマクロです。
Sub SetUF()
Dim FPath As String
Dim x As Variant
x = Application.Caller
If VarType(x) <> vbString Then Exit Sub
FPath = ActiveSheet.Pictures(x) _
.ShapeRange.AlternativeText
MsgBox FPath
If UserForms.Count > 0 Then Unload UserForm1
UserForm1.Show
On Error Resume Next
With UserForm1.Image1.Picture
.LoadPicture = ""
.LoadPicture = FPath
End With
End Sub
*コードは間違いないはずですが、なぜかこちらのテストでは何度やっても
画像を表示できませんでした。
こちらのImageオブジェクトは、どこかがおかしいみたいです・・。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
