[[20120924121850]] 『社員番号を入れると社員の顔写真が貼り付けられる』(SB) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『社員番号を入れると社員の顔写真が貼り付けられるようにしたい』(SB)

F8:G9の結合セルに社員番号を入れると、B2:C9の結合セルにその社員番号の顔写真が貼りつけられ、番号をDeleteすると画像も消えるようにしたいです。

元の画像サイズはバラバラなので貼り付ける時に自動的にセルに合わせるような形で構い
ません。

ちなみに画像の読込先は"E:\社員画像\"で、画像ファイルは「社員番号.jpg」で保存してあります。

どうぞ、お教授お願いいたします。

Excel2007 、winXPです。


http://officetanaka.net/excel/function/tips/tips14.htm
 これが良いんじゃないかと思うけど?
 ただ、人数が多いとファイルが重くなる。

 他
 結合セルいっぱいいっぱいに図形を作っておく。

 以下をマクロ記録して
 Private Sub Worksheet_Change(ByVal Target As Range)
 で応用。

 ここからマクロ記録。

 図を右クリック
 オートシェイプの書式設定
  ↓
 色と線
  ↓
 塗りつぶし
  ↓
 色
  ↓
 塗りつぶし効果
  ↓
 図
  ↓
 図の選択

 消去は、色→塗りつぶし無で。
 これもマクロ記録して応用。
 では。
 BJ

Private Sub Worksheet_Change(ByVal Target As Range)
    Const cPath = "E:\社員画像\"

    If Target.Row = 8 And Target.Column = 6 Then
        If Target.Text <> "" Then
            If Dir(cPath & Target.Text & ".jpg") <> "" Then
                Range("B2:C9").Select
                ActiveSheet.Pictures.Insert(cPath & Target.Text & ".jpg").Select
                With Selection
                    .Width = Range("B2:C9").Width
                    .Height = Range("B2:C9").Height
                End With
            Else
                Pictures.Delete
            End If
        Else
            Pictures.Delete
        End If
    End If
End Sub
(???)


???さま
早速、ご教授いただいたマクロコードでやってみました。

画像は出てくるのですが、指定セルより右斜め下に約1cm程度ズレて表示されます。
画像サイズは、指定セルの大きさに調整されていますが・・・。

どうしたら良いでしょうか?

(SB)


    .Left = Range("B2:C9").Left
    .Top = Range("B2:C9").Top
(???)

 >ここからマクロ記録。
Excel2007では図形等の記録はできないので 
別の方法として
イメージコントロールを配置して画像の表示方法は
If Target.Value <> "" Then
   Image1.Picture = LoadPicture(cPath & Target.Text & ".jpg")
Else
   Image1.Picture = LoadPicture("")
End If
ちなみにPictures.Deleteはシート内の全てのPictures(ActiveXコントーロールも)
が削除されますのでご注意を・・・
(ROM人)

 先日、『データ取り込みマクロを作っているのですが、』でお世話になった(jojo)と
 いう者ですが、上の質問で作っているマクロと、今回の質問の回答は似ているな?と
 思われる箇所が多々あったので、書き込んでみました。

 まず、私のマクロの知識は自動実行マクロをアレンジする程度とご理解ください。
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

 さて、質問の件を要約すると、

 ・指定されたセルに社員番号を入れると、
 ・指定された結合セルに社員番号の顔写真が貼りつけられ、
 ・番号をDeleteすると画像も消える
 ・画像サイズはバラバラなので貼り付ける時に自動的にセルに
 ・画像の読込先は"E:\社員画像\"で、
 ・画像ファイルは「社員番号.jpg」で保存してあります。

 という事ですが、私の場合は「名簿」という全てのデータが入っているワークシー
 トから、それらの内容を一枚のカルテ画面シートに書き出すというものです。

 流れとしては、「カルテ」シートのA行に、顧客データの全てを「値」として取込み
 (これが前回の質問でした。)
 そして、この場所をカルテ画面にリンクさせているだけですが、、、

 その際に、画像の読込も「Application.Run "顧客管理.xls!画像を取り込む"」 で、
 貼り付けています。
 もし、(SB)さんが同じようなイメージを持っているのならと、書き込んでみました。

 ps:色々な人達のマクロを参考に試行錯誤して作ったものなので、マクロの書式
    は目茶目茶ですが、何とか思った通りの事をしてくれています。

 Sub 画像を取り込む()
     Dim myFileName As String
     Dim myShape As Shape
     Dim gazo As String
     gazo = Range("C1").Value   'ここに「顧客画像\○○○○.JPG」と...

     myFileName = ActiveWorkbook.Path & "\" & gazo  

         Select Case Range("C1")    'ここは私の都合で書いてあります。
             Case ""
                 MsgBox ("画像がありません")
                 GoTo owari

             Case " "
                 MsgBox ("画像がありません")
                 GoTo owari

             End Select

     Sheets("カルテ").Select
     Range("G5").Select     'G5:J17を結合してある

     If myFileName <> "False" Then
         With ActiveSheet.Pictures.Insert(myFileName) '画像の取り込み設定
             .Left = Selection.Left
             .Top = Selection.Top
             .Width = Selection.Width
             .Height = Selection.Height

         End With
     End If

 owari:
 End Sub

 Sub 画像を消す()

     Range("G5").Select
     Selection.ClearContents
     For Each sel In ActiveSheet.Shapes

         If sel.Type <> 8 Then
             sel.Delete
         End If
     Next

 End Sub
 (jojo)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.