Excel VBA質問箱 IV

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

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


41932 / 76732 ←次へ | 前へ→

【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 質問
【39846】Re:UserFormへの画像の張り付け方 bykin 06/7/2(日) 23:11 回答
【39862】Re:UserFormへの画像の張り付け方 わいわい 06/7/3(月) 13:14 質問
【39874】Re:UserFormへの画像の張り付け方 Kein 06/7/3(月) 14:53 回答
【39890】Re:UserFormへの画像の張り付け方 わいわい 06/7/3(月) 18:15 質問
【39997】Re:UserFormへの画像の張り付け方 ichinose 06/7/5(水) 8:48 発言
【40137】Re:UserFormへの画像の張り付け方 わいわい 06/7/7(金) 13:48 お礼
【40371】Re:UserFormへの画像の張り付け方 ichinose 06/7/12(水) 17:45 発言
【40411】Re:UserFormへの画像の張り付け方 わいわい 06/7/13(木) 13:31 お礼

41932 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free