| |
先日、「初めてのマクロで困ってます」でお世話になりました
まつじゅんです。
当初の目的をほぼクリアーし更に改造したいと思い
新規投稿とさせて頂きました。
さて、今回は…。
下記のようなコードを用いて画像表示をさせている
照明設置表において、
現在 画像ファイルを特定のホームページからダウンロードして
保存しているのですが、
季節毎に商品の入れ替えをする関係でListBoxに表示されていない
新製品の画像を直接読み込む事ができればより使いやすくなるかと思い
皆様のアドバイスをお願いしたく投稿しました。
前回の投稿で完成させたuserformのマクロです。
Private Sub ExitBtn_Click()
Unload Me
End
End Sub
Private Sub InputBtn_Click()
Dim MyPicture As Object
Dim MyRow As Long
Dim 設置場所 As String
設置場所 = StrConv(StrConv(TextBox1.Value, vbNarrow), vbUpperCase)
If ListBox1.ListIndex = -1 Then
MsgBox "商品番号を選択して下さい。"
ListBox1.SetFocus
Exit Sub
ElseIf 設置場所 = "" Then
MsgBox "設置場所を入力してください。"
TextBox1.SetFocus
Exit Sub
ElseIf Len(設置場所) <> 3 Or Val(Right(設置場所, 2)) _
> 44 Or Val(Right(設置場所, 2)) < 15 Then
MsgBox "設置場所に不適切な値が入力されています。"
TextBox1.SetFocus
Exit Sub
End If
Select Case Left(設置場所, 1)
Case "V"
MyRow = 4
Case "W"
MyRow = 6
Case "X"
MyRow = 8
Case "Y"
MyRow = 10
Case "Z"
MyRow = 12
Case "A"
MyRow = 14
Case "B"
MyRow = 16
Case "C"
MyRow = 18
Case "D"
MyRow = 20
Case "E"
MyRow = 22
Case "F"
MyRow = 24
Case "G"
MyRow = 26
Case "H"
MyRow = 28
Case "I"
MyRow = 30
Case Else
MsgBox "設置場所に不適切な値が入力されています。"
TextBox1.Value = ""
TextBox1.SetFocus
Exit Sub
End Select
Cells(MyRow, 46 - Val(Right(設置場所, 2))).Value = ListBox1.Value
Set MyPicture = ActiveSheet.Pictures.Insert("D:\picture1\" & ListBox1.Value & ".jpg")
With Cells(MyRow + 1, 46 - Val(Right(設置場所, 2)))
MyPicture.Top = .Top
MyPicture.Left = .Left
MyPicture.Width = .Width
MyPicture.Height = .Height
End With
TextBox1.Value = ""
ListBox1.SetFocus
End Sub
Private Sub ListBox1_Click()
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & ListBox1.Value & ".jpg")
End Sub
Private Sub UserForm_Initialize()
Dim jpgDir As String
Dim Fname As String
jpgDir = ThisWorkbook.Path & "\*.jpg"
Fname = Dir(jpgDir, vbNormal)
Do
ListBox1.AddItem Left(Fname, Len(Fname) - 4)
Fname = Dir
Loop While Fname <> ""
End Sub
|
|
- 03/4/10(木) 16:33 -
