[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『社員番号を入れると社員の顔写真が貼り付けられるようにしたい』(SB)
F8:G9の結合セルに社員番号を入れると、B2:C9の結合セルにその社員番号の顔写真が貼りつけられ、番号をDeleteすると画像も消えるようにしたいです。
元の画像サイズはバラバラなので貼り付ける時に自動的にセルに合わせるような形で構い
ません。
ちなみに画像の読込先は"E:\社員画像\"で、画像ファイルは「社員番号.jpg」で保存してあります。
どうぞ、お教授お願いいたします。
Excel2007 、winXPです。
これが良いんじゃないかと思うけど? ただ、人数が多いとファイルが重くなる。
他 結合セルいっぱいいっぱいに図形を作っておく。
以下をマクロ記録して Private Sub Worksheet_Change(ByVal Target As Range) で応用。
ここからマクロ記録。
図を右クリック オートシェイプの書式設定 ↓ 色と線 ↓ 塗りつぶし ↓ 色 ↓ 塗りつぶし効果 ↓ 図 ↓ 図の選択
消去は、色→塗りつぶし無で。 これもマクロ記録して応用。 では。 BJ
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.