1215172879 エクセルのマクロの質問です。今度バーコードで商品を管理することになりました。現在、商品番号、商品名等の商品情報を「商品管理.xls」というファイルに記載しております。バーコードを付けやすくするため商品番号に対応する商品画像を「商品管理.xls」に載せたいと思います。

http://q.hatena.ne.jp/1154052414 で紹介されていた方法で、商品画像を「商品管理.xls」に載せることはできました。
これにさらに次の機能を追加するにはどうしたらよいでしょうか?
・"商品番号"列のセルを複数選択してマクロを実行、選択した商品番号に対応する商品画像を表示、選択したセルの行の高さを"128"にする。
マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のためサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。

回答の条件
  • 1人5回まで
  • 登録:2008/07/04 21:01:21
  • 終了:2008/07/05 11:19:29

回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/07/04 22:09:12

tmp = ActiveWorkbook.Path & "\商品画像\" & Mid(ActiveCell.Value, 1, Len(ActiveCell.Value) - 3) & "m.jpg"

ここの名前の後ろの3文字を削除して、"m.jpg"をつけるというのがよくわからないけど、

そのまま使って作ってみました。

勝手に前のマクロの仕様も少し引き継いでいます。


Option Explicit

Sub PicInsert()
    Dim wsKan As Worksheet
    Dim SNameRetu As Integer     '商品名列
    Dim SGazouRetu As Integer    '商品番号列
    Dim tmp As String
    Dim r As Range
    
    If ThisWorkbook.Name <> "商品管理.xls" Or ActiveSheet.Name <> "商品管理" Then
        MsgBox "操作が誤っています。商品画像を挿入する場合は商品管理ファイルの" & _
            "商品管理シートの商品名列でマクロを実行してください。"
        Exit Sub
    End If
    
    Set wsKan = Worksheets("商品管理")
    
    'タイトル列がない場合の処理
    Set r = wsKan.Rows(1).Find(what:="商品名", lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "商品名の列名は存在しません。商品管理シートを確認してください。"
        Exit Sub
    Else
        SNameRetu = r.Column
    End If
    
    Set r = wsKan.Rows(1).Find(what:="商品画像", lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "商品画像の列名は存在しません。商品管理シートを確認してください。"
        Exit Sub
    Else
        SGazouRetu = r.Column
    End If
    
    '商品名のセル選択しているか
    If Selection.Columns.Count <> 1 Or Selection.Column <> SNameRetu Then
        MsgBox ("商品名を選択してください。")
        Exit Sub
    End If
    
    For Each r In Selection
        If Len(r.Value) > 3 Then
            tmp = ActiveWorkbook.Path & "\商品画像\" & Mid(r.Value, 1, Len(r.Value) - 3) & "m.jpg"
            If Dir(tmp) <> "" Then
                wsKan.Cells(r.Row, SGazouRetu).Select
                wsKan.Pictures.Insert(tmp).Select
                wsKan.Rows(r.Row).RowHeight = 128
            Else
                wsKan.Cells(r.Row, SGazouRetu).Value = "NO IMAGE"
            End If
        End If
    Next
End Sub
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692008/07/05 08:24:50

ポイント1500pt
Option Explicit

Sub PicInsert()
    Dim wsKan As Worksheet
    Dim SNumRetu As Integer      '商品番号列
    Dim SGazouRetu As Integer    '商品画像列
    Dim tmp As String
    Dim r As Range
    Dim s As Shape
    Dim LastRow As Long
    Dim i As Long
    
    If ThisWorkbook.Name <> "商品管理.xls" Or ActiveSheet.Name <> "商品管理" Then
        MsgBox "操作が誤っています。商品画像を挿入する場合は商品管理ファイルの" & _
            "商品管理シートの商品番号列でマクロを実行してください。"
        Exit Sub
    End If
    
    Set wsKan = Worksheets("商品管理")
    
    'タイトル列がない場合の処理
    Set r = wsKan.Rows(1).Find(what:="商品番号", lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "商品番号の列名は存在しません。商品管理シートを確認してください。"
        Exit Sub
    Else
        SNumRetu = r.Column
    End If
    
    Set r = wsKan.Rows(1).Find(what:="商品画像", lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "商品画像の列名は存在しません。商品管理シートを確認してください。"
        Exit Sub
    Else
        SGazouRetu = r.Column
    End If
    
    Application.ScreenUpdating = False
    
    '画像の挿入か削除の選択
    If MsgBox("商品画像を挿入しますか?" & vbNewLine & _
        "[はい] →選択したセルの商品画像を挿入する。" & vbNewLine & _
        "[いいえ] →商品画像を一括削除する。", vbYesNo) = vbYes Then
        '商品番号のセル選択しているか
        If TypeName(Selection) <> "Range" Then Exit Sub
        If Selection.Columns.Count <> 1 Or Selection.Column <> SNumRetu Then
            MsgBox ("商品番号を選択してください。")
            Exit Sub
        End If
        
        For Each r In Selection
            If Len(r.Value) > 3 Then
                tmp = ActiveWorkbook.Path & "\商品画像\" & Mid(r.Value, 1, Len(r.Value) - 3) & "m.jpg"
                If Dir(tmp) <> "" Then
                    wsKan.Cells(r.Row, SGazouRetu).Select
                    wsKan.Pictures.Insert(tmp).Select
                    wsKan.Rows(r.Row).RowHeight = 128
                Else
                    '画像が無かった場合NO IMAGEと表示
                    wsKan.Cells(r.Row, SGazouRetu).Value = "NO IMAGE"
                End If
            End If
        Next
    Else
        '画像だけ削除
        For Each s In wsKan.Shapes
            If s.Type = msoPicture Then
                s.Delete
            End If
        Next
        '行の高さを調整
        LastRow = wsKan.Cells(Cells.Rows.Count, SNumRetu).End(xlUp).Row
        For i = 2 To LastRow
            wsKan.Cells(i, SGazouRetu).Value = ""
            wsKan.Rows(i).RowHeight = 12
        Next i
    End If
    
    Application.ScreenUpdating = True
End Sub
  • id:icta
    このマクロを利用するのはエクセルの知識がほとんどない販売スタッフです。
    エクセルを知らなくてもで簡単に画像付きの"商品管理”シートを作成できるマクロを作成したいと考えています。
    お知恵とお力をお借りできれば幸いです。
    仕様で何かご不明な点ありましたらお知らせください。

    ■マクロの仕様

    ○概要
    ・「商品管理」シートで画像を挿入したい商品番号を複数選択。
    ・マクロ実行。
    ・「商品画像」フォルダから選択した商品番号に対応する商品画像を表示、選択したセルの行の高さを"128"する。
    ・マクロを終了する。

    ■マクロ
    http://q.hatena.ne.jp/1154052414 で紹介されていた方法で製作したマクロ。
    このマクロでは複数選択と行の高さに対応していない。

    Sub 商品画像()
    Dim tmp As String

    tmp = ActiveWorkbook.Path & "\商品画像\" & Mid(ActiveCell.Value, 1, Len(ActiveCell.Value) - 3) & "m.jpg"
    If Dir(tmp) > "" Then
    ActiveCell.Offset(0, 2).Select
    ActiveSheet.Pictures.Insert(tmp).Select
    ActiveCell.Offset(0, -1).Select
    Else
    MsgBox "ファイルが見付かりません。"
    End If
    End Sub

    ■サンプルデータ(半角スペース区切り)

    商品番号 商品名 商品画像 バーコード 販売価格 入庫数 ラベル 分類 発売日
    S060302PK1 カーディガン/ピンク/ワンサイズ *S060302PK1* 8000 19 20 トップス 11/21
    H020101SV3 リング/シルバー/9号 *H020101SV3* 18000 3 4 ジュエリー 11/21
    R050901DN1 ジーンズ/ネイビー/1 *R050901DN1* 19800 0 1 ボトムス 12/22
  • id:icta
    >SALINGERさん

    早々のご回答ありがとうございます。
    アップした画像が間違っておりました。
    正しくは、商品名を選択ではなく商品番号を選択です。

    ▼以下のようになります。
    商品番号H020101SV3→画像H020101m.jpg

    お手数をおかけしてしまって申し訳ありませんが、ご都合のつくときに修正をお願いできれば幸いです。
  • id:SALINGER
    コード中の全ての「商品名」を「商品番号」にすればいいです。
  • id:icta
    > SALINGERさん
    早々のご回答ありがとうございました。
    希望通りの動作を確認しました。
    使ってみて気づいたのですが、挿入した画像をすべて削除することが画像を挿入することと同じくらいの頻度であります。
    そのため、マクロ実行後に▼次のメッセージを出し、画像の挿入と画像の一括削除を分岐させることは可能でしょうか?

    「商品画像を挿入しますか?
    [はい]→選択したセルの商品画像を挿入する。
    [いいえ]→商品画像を一括削除する。」

    ※マクロはいずれも"商品番号"列上で実行する。
    ※商品画像を一括削除する場合は、タイトル行を除く、2行目から行の最終列までの行の高さを12にする。

    何度もお手数をおかけして申し訳ありません。
    ご都合のよいときにお力をお借りできれば幸いです。
  • id:icta
    > SALINGERさん
    早々のご回答ありがとうございました。
    希望通りの動作を確認しました。
    何度もお手数を煩わせて申し訳ありませんでした。
    これで画像付きの商品リストが簡単に出せそうです。
    このリストはバーコード導入にあたって、現在ある商品にバーコードを付けるために用います。
    バーコードが全て付け終わったら、バーコードリーダーで全ての商品を読み込み、棚卸しを行います。
    棚卸しのためにバーコードリーダーで読んだ商品をカウントするマクロが必要になります。
    その質問を▼下記に投稿しました。
    http://q.hatena.ne.jp/1215223897
    お手すきの時にお力をお借りできれば幸いです。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません