|
初めまして、VBA初心者のまつじゅんです。
VBAの本等を参考に照明配置図を作っております。
ユーザーフォームを使って各照明器具毎のワークシートに
配置を出来るようにしたいと思い下記の様は物を作ってみました。
リストボックスに商品番号を表示させて、イメージボックスにその画像を
表示させる事は出来たのですが、
任意のセル(例 B4 設置番地 V44、B6 設置番地 W44の)に
テキストボックス1で入力した商品番号をセル番地(設置番地)に転送し、
そのすぐ下のセルには、イメージボックスの拡大された別画像を転送させたいと
思っております。
(イメージボックの画像と拡大された画像は別のファイルフォルダに保存ます)
参考にしたマクロでは、選んだ商品番号を新たなワークシート名として
画像を表示させるような物だと思うのですが、
新たなワークシートは作成されなくて良いのです。
マクロをほぼ丸写しなのでどこを改造して良いのかわからず
ひょっとしたら全然違うマクロを作っているような気がして投稿しました。
何方か良いアドバイスをよろしくお願いします。
Dim ImgName As String
Private Sub ExitBtn_Click()
Unload Me
End
End Sub
'ここからが転送についてのマクロだと思います'
Private Sub InputBtn_Click()
Dim WSName As String
Dim i As Variant
WSName = NameBox.Text
If WSName = "" Then
MsgBox "商品番号をお入れ下さい"
NameBox.SetFocus
Exit Sub
ElseIf ImgName = "" Then
MsgBox "商品の写真をお選び下さい"
ListBox1.SetFocus
Exit Sub
End If
For Each i In Worksheets
If i.Name = WSName Then
GoTo FAIL
End If
Next
Worksheets("WSName").Copy before:=Worksheets("WSName")
ActiveSheet.Name = WSName
With Worksheets(WSName)
.Range("E4") = WSName
.Range("E6") = ClassBox.Text
.Image1.Picture = LoadPicture(ImgName)
End With
NameBox = ""
ClassBox = ""
ListBox1.SetFocus
Exit Sub
FAIL:
MsgBox "既に同じ番号が登録されております" & Chr(13) _
& "番号を確かめてもう1度入力して下さい"
NameBox.SetFocus
End Sub
'ここまで'
Private Sub ListBox1_Click()
ImgName = ListBox1.List(ListBox1.ListIndex)
ImgName = ActiveWorkbook.Path & "\" & ImgName
Image1.Picture = LoadPicture(ImgName)
End Sub
Private Sub UserForm_Initialize()
Dim jpgDir As String
Dim Fname As String
jpgDir = ActiveWorkbook.Path & "\*.jpg"
Fname = Dir(jpgDir, vbNormal)
ListBox1.AddItem Fname
Do
Fname = Dir
ListBox1.AddItem Fname
Loop While Fname <> ""
End Sub
|
|