| |
初めまして、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
|
|
まつじゅん
- 03/4/7(月) 16:43 -
