[[20140307142421]]　『社員リストに社員番号に応じた画像を挿入したい』（hishimatsu）　ページの最後に飛ぶ

『社員リストに社員番号に応じた画像を挿入したい』（hishimatsu）

教えてください。

150名ほどの社員一覧リストを作成したいのですが、社員番号に応じて顔写真を表示したいと思っています。

具体的にはＢ列に社員番号を入力すると、同じ行のＡ列に写真がセルのサイズ内におさまって挿入されるようにしたいです。（小さすぎずセルの中で縦横の比率を変えず最大化）

顔写真のファイルはC:\Users\ユーザー名\Desktop\社員画像\というフォルダの中に
「社員番号.jpg」の形式で格納されています。

Ａ列　　　　　Ｂ列
社員画像　　社員番号
1111.jpg　　　1111
1112.jpg　　　1112
1113.jpg　　　1113

こんな感じで画像を表示したいのですが、良い方法はないでしょうか？

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

入力の度に1画像ではなく、ボタン押下等でいっきに全部貼るほうが良いとは思いますが、とりあえず入力時の例。

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 2 Then
        With Pictures.Insert("C:\Users\ユーザー名\Desktop\社員画像\" & Target.Text & ".jpg")
            .Left = Cells(Target.Row, "A").Left
            .Top = Cells(Target.Row, "A").Top
            .Width = Cells(Target.Row, "A").Width
            If Cells(Target.Row, "A").Height < .Height Then
                .Height = Cells(Target.Row, "A").Height
            End If
        End With
    End If
 End Sub
（???） 2014/03/07(金) 14:59

 衝突しましたが、ボタン押下げのほうが私もいいと思う、ということでそっちの提案。
Sub hishimatsu()
    Dim last_row As Long
    Dim i As Long
    Dim tmpPic As Shape
    last_row = Range("A" & Cells.Rows.Count).End(xlUp).Row
    Const P_Path = "C:\エクセルの学校\hishimatsu\"
    For i = 1 To last_row
        Set tmpPic = ActiveSheet.Shapes.AddPicture( _
                        Filename:=P_Path & Cells(i, "B").Value & ".jpg", _
                        LinkToFile:=True, _
                        SaveWithDocument:=False, _
                        Left:=Cells(i, "A").Left, _
                        Top:=Cells(i, "A").Top, _
                        Width:=0, _
                        Height:=0)
        With tmpPic
            .LockAspectRatio = True
            .ScaleHeight 1!, True
            If .Height / Cells(i, "A").Height > .Width / Cells(i, "A").Width Then
                .Height = Cells(i, "A").Height
            Else
                .Width = Cells(i, "A").Width
            End If
        End With
    Next i
End Sub
（稲葉） 2014/03/07(金) 15:24

稲葉様　？？？様

ご教授ありがとうございます。

稲葉様
当方ＶＢＡのことはまるで分らず、初歩的な質問ですみませんが、
「押下げで一気に」とはどういう意味でしょうか？

また「"C:\エクセルの学校\hishimatsu\"」のところを変更してマクロを実行してみたのですが
「４００」というエラーが返ってきて途方に暮れております。

どのようにすればよいのか、もう一歩教えてください。
よろしくお願いします。
（hishimatsu） 2014/03/07(金) 17:29

 「押下げで一気に」は私の言葉ではないが・・・
 フォームボタンや図にマクロを登録し、クリックした時に1度だけ実行されるマクロのことです。

 400エラーについては、2010で互換性ブックを使用していると推測・・・
http://plaza.rakuten.co.jp/mscrtf/diary/201303120000/
 こちらを試してみてください。

 分からなければステップ実行で何行目にエラーが出るとかもう少し情報頂かないとこちらも対応
 出来ません。
（稲葉） 2014/03/10(月) 08:55

 お邪魔します。
 400エラーとは別件ですが、下記は、A列でなくB列？
 ＞last_row = Range("A" & Cells.Rows.Count).End(xlUp).Row
（マナ） 2014/03/10(月) 20:44

コメント返信：

[ 一覧(最新更新順) ]

[[20140307142421]] 『社員リストに社員番号に応じた画像を挿入したい』（hishimatsu） ページの最後に飛ぶ

[[20140307142421]]　『社員リストに社員番号に応じた画像を挿入したい』（hishimatsu）　ページの最後に飛ぶ