Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


76342 / 76732 ←次へ | 前へ→

【4812】Re:初めてのマクロで困ってます。
回答  ポンタ  - 03/4/8(火) 16:51 -

引用なし
パスワード
   >今の画像ファイル名だと拡張子がついたままで表示されてしまうので
>表の中での表記には不用かと思いあえて 商品番号のみを入力し
>転送させるようにしてみました。

  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

2 hits

【4787】初めてのマクロで困ってます。 まつじゅん 03/4/7(月) 16:43 質問
【4801】Re:初めてのマクロで困ってます。 ポンタ 03/4/8(火) 11:38 回答
【4811】Re:初めてのマクロで困ってます。 まつじゅん 03/4/8(火) 16:07 質問
【4812】Re:初めてのマクロで困ってます。 ポンタ 03/4/8(火) 16:51 回答
【4838】Re:初めてのマクロで困ってます。 まつじゅん 03/4/10(木) 8:52 質問
【4839】Re:初めてのマクロで困ってます。 ポンタ 03/4/10(木) 9:41 発言
【4847】Re:初めてのマクロで困ってます。 まつじゅん 03/4/10(木) 13:52 お礼

76342 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free