| |
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
これを改良していき、機能を満足させるつもりです。ありがとうございました。
|
|
わいわい
- 06/7/7(金) 13:48 -
