| |
▼ポンタ さん：
おはようございます。
下記の質問を踏まえてマクロを書きました。
アドバイスがあればまお願いいたします。
それと、更に質問があります。
この全ての画像は、ホームページから画像保存しているのですが、
これを直接ホームページに読みに行く事は出来るのでしょうか？
年に数度商品の入れ替えがある為、新商品のチェックをしたいと思います。
>>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(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("G:\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(木) 8:52 -
