Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

41935 / 76735

←次へ　｜　前へ→


	【39874】Re:UserFormへの画像の張り付け方

Kein - 06/7/3(月) 14:53 -


	引用なし

	パスワード

シート上に配置した任意の画像ファイルをクリックすると、
ユーザーフォームを出して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オブジェクトは、どこかがおかしいみたいです・・。

0 hits

▼

【39845】UserFormへの画像の張り付け方 わいわい 06/7/2(日) 22:18