Excel VBA質問箱 IV

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

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


41674 / 76732 ←次へ | 前へ→

【40137】Re:UserFormへの画像の張り付け方
お礼  わいわい  - 06/7/7(金) 13:48 -

引用なし
パスワード
   ichinose 様

いつも解答ありがとうございす。
ご提示頂いた、リストを確認してみましたが、そのままでは、画像のUserForm1への貼付けが出来ませんでした。
そこでctmp.filesフォルダ内を調べてみると、私の環境WinXP SE、Excel2000では、以下のような結果となりました。

Set shp = ActiveSheet.Shapes("Picture 1")の場合
  ctmp.files内には、filelist.xml、image001.png、image002.jpg が出来ます。
Set shp = ActiveSheet.Shapes("Rectangle 1")の場合
  ctmp.files内には、filelist.xml、image001.jpg が出来ます。
Set shp = ActiveSheet.Shapes("Group 3")の場合
  ctmp.files内には、filelist.xml、image001.jpg が出来ます。
Set shp = ActiveSheet.Shapes("Object 1")の場合
  filelist.xml、image001.emz、image002.gif、oledata.mso が出来ます。
以上から、今回は"Picture 1"を利用しているので
>     If UCase(fl.Name) Like UCase("image001.*") Then
を     If UCase(fl.Name) Like UCase("image002.*") Then
に変更して表示できました。
ichinoseさんの環境では、UCase("image001.*")で表示できるのでしょうか?多数の人間が使うことを想定していますので、環境によって条件が変わるようだと考えなければなりません。逆に考えてExcelからctmp.filesフォルダへ書出すファイルを制御する方法があればお教え下さい。

とここまでUserForm上に表示する方法を相談させていただいたのですが、手練の皆様の解答を見て、簡単な命令ではないことが分かりました。そこでよく考えると、今回のケースでは、画像の切替表示さえ出来れば良いので画像自体を貼り付けるという方法にすればと思い、以下のリストを作成しました。
>>> Sheet3の1列目に適当な数字を入力する。
>>> Sheet2に Picture 1、Picture 2、Picture 3 を予め準備する。
>>>Sheet2のシートモジュールに
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.ScreenUpdating = False
  Macro1
  Application.ScreenUpdating = True
End Sub
>>>標準モジュールに
Sub Macro1()
  R = ActiveCell.Row
  C = ActiveCell.Column
  j = ActiveSheet.Cells(R, 1).Value
  Select Case j
    Case 1, 2, 3:  P_Name = "Picture " & j
    Case Else:   Exit Sub
  End Select
    With ActiveSheet
      k = .DrawingObjects.Count
      If k <> 0 Then .DrawingObjects(1).Delete
    End With
    Sheets("Sheet2").Select
    ActiveSheet.Shapes(P_Name).Select
    Selection.Copy
    Sheets("Sheet3").Select
    With ActiveSheet
      .Paste
      .DrawingObjects(1).Select
      Selection.ShapeRange.Left = 648
      Selection.ShapeRange.Top = 270
      .Cells(R, C).Select
    End With
End Sub

これを改良していき、機能を満足させるつもりです。ありがとうございました。

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

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