Excel VBA質問箱 IV

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

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


41812 / 76732 ←次へ | 前へ→

【39997】Re:UserFormへの画像の張り付け方
発言  ichinose  - 06/7/5(水) 8:48 -

引用なし
パスワード
   おはようございます。

シートに配置された画像を一度ファイルに落とした後、
それをImageコントロールで読み込むという考え方です。

新規ブックに
 ユーザーフォーム(Userform1)を作成します。
  コントロールは イメージコントロール(Image1)ひとつ


適当なシートをアクティブにした後、

Sub Macro1()
  ActiveSheet.Pictures.Insert "画像パス.jpg"
End Sub
このようなコードでシートに画像を配置してください。

標準モジュールに

'============================================================
Sub test1()
  Dim imgnm As String
  Dim shp As Shape
  Call del_html(ThisWorkbook.path & "\ctmp.htm")
  Set shp = ActiveSheet.Shapes("Picture 1")
'                  ↑実際の名前
  With Workbooks.Add
    shp.Copy
    .Worksheets(1).Paste
    .SaveAs Filename:=ThisWorkbook.path & "\ctmp.htm", _
        FileFormat:=xlHtml, _
        ReadOnlyRecommended:=False, _
        CreateBackup:=False
    .Close False
    End With
  UserForm1.Show vbModeless
  With UserForm1.Image1
    imgnm = get_imgnm(ThisWorkbook.path & "\ctmp.htm")
    If imgnm <> "" Then .Picture = LoadPicture(imgnm)
    End With
  Call del_html(ThisWorkbook.path & "\ctmp.htm")
   
End Sub
'============================================================
Function get_imgnm(htmlnm As String) As String
  On Error Resume Next
  Dim fso As Object
  Dim fl As Object
  get_imgnm = ""
  Set fso = CreateObject("Scripting.FileSystemObject")
  With fso
    For Each fl In .getfolder(.GetParentFolderName(htmlnm) & "\" & .getbasename(htmlnm) & ".files").Files
     If UCase(fl.Name) Like UCase("image001.*") Then
       get_imgnm = fl.path
       Exit For
       End If
     Next
    End With
  Set fso = Nothing

End Function
'============================================================
Sub del_html(path As String)
  On Error Resume Next
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  With fso
    .getfile(path).Delete
    .getfolder(.GetParentFolderName(path) & "\" & .getbasename(path) & ".files").Delete
    End With
  Set fso = Nothing
End Sub

Thisworkbook.Pathをコード内で使っていますから、
一度保存した後、test1を実行してみてください。

画像を別の新規ブックにコピーし、Htmlで保存します。
ここから、画像ファイルをサーチし、Imageコントロールに読み込む
というアルゴリズムです。

画像をファイルに落とす方法は他にもあったかと思いますが、
今回は、Htmlから、取得しました。

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 お礼

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