| |
>今の画像ファイル名だと拡張子がついたままで表示されてしまうので
>表の中での表記には不用かと思いあえて 商品番号のみを入力し
>転送させるようにしてみました。
ListBox1.AddItem Left(Fname, Len(Fname) - 4)
と書き直せば、拡張子は省けます。
よって、
>TextBoxの表示について再考しました。
>
>TextBox1＝商品番号入力用
>TextBox2＝設置場所入力用
はTextBox2さえあれば事足りると思います。
>A列4に「V」 以下 6「W」 8「X」と順に 1行飛ばしで「A」まで
V から始まって A で終わるという規則が理解できませんでした。
V→W→X→Y→Z→A
ということですか？
そう仮定して書き直しました。
お試しください。
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(TextBox2.Value, vbNarrow), vbUpperCase)
If ListBox1.ListIndex = -1 Then
MsgBox "商品番号を選択して下さい"
ListBox1.SetFocus
Exit Sub
ElseIf 設置場所 = "" Then
MsgBox "設置場所を入力して下さい"
TextBox2.SetFocus
Exit Sub
ElseIf Len(設置場所) <> 3 Or Val(Right(設置場所, 2)) _
> 44 Or Val(Right(設置場所, 2)) < 15 Then
MsgBox "設置場所に不正な値が入力されています"
TextBox2.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 Else
MsgBox "設置場所に不正な値が入力されています"
TextBox2.Value = ""
TextBox2.SetFocus
Exit Sub
End Select
Cells(MyRow, 45 - Val(Right(設置場所, 2))).Value = ListBox1.Value
Set MyPicture = ActiveSheet.Pictures.Insert("G:\picuture1\" & ListBox1.Value & ".jpg")
With Cells(MyRow + 1, 45 - Val(Right(設置場所, 2)))
MyPicture.Top = .Top
MyPicture.Left = .Left
End With
TextBox2.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
|
|
