エクセルで薬剤情報提供用紙をつくりたいが薬剤画像は

よく保険薬局なんかでお薬をもらえば、お薬の説明書をもらうが、いまその提供用紙　老人施設でも
つくりたい、保険薬局のように立派なその種の機械が購入できないのでエクセルでつくろうと思っているのですが、薬剤情報提供ホルダーにお薬の各　効能、副作用、画像を集めて入れておいたとき
たとえばある入居者のお薬が、○、△、◇とあった場合、効能と副作用なんかはVLOOK関数で表示できるが画像の場合　画像の出したいところに、出すためにはどのようにすればいいのか。一つ一つ貼り付けるのも手間がかかる、何かの関数でポット画像を出すわけにはゆかないものなのでしょうか。

質問者からの補足コメント

• 有難うございます。一品目ですが画像は出てまいりました。画像.png　にしましたらでてきたのですが、横長になって不自然、それに大きくなってしまうんです。小さくして　また複数　6－7種類　一人に処方されるんですが、画像複数出させるためには　どこをどうなおせばいいのでしょうか。

  No.5の回答に寄せられた補足コメントです。 補足日時：2019/11/18 01:21

• 大変　ご親切に有難う　できました。患者のお薬画像が一応全部出てきて　多少　位置の移動　大きさなどは手動でできますので大丈夫です。有難うございました！！　感謝感謝です。100人ほどの老人入居施設で働いている薬剤師です。大変助かります。
  追伸　何とかは生るんですが　追加していただいた　画像除去プログラムが何故か貼り付けても動きませんが何とかでも手動で対応いたします。有難うございました。

  No.8の回答に寄せられた補足コメントです。 補足日時：2019/11/18 17:29

• 有難うございました、ついでながらできればでいいんですが、画像がそろったとき　画像抽出しましたと出るのですが、完全にそろったときは出ないで終了し、そろわないときだけ、画像が見つかりませんと出るようにするにはどうすればいいのでしょうか。

  No.10の回答に寄せられた補足コメントです。 補足日時：2019/11/22 17:34

No.10 ベストアンサー 回答者： Qchan1962 回答日時： 2019/11/18 18:43

＞多少　位置の移動　大きさなどは手動、、、追伸、、

位置調整を加えました。。画像の抽出方法も少し見直してみました。
削除もこちらならできるかと思います。
これを使うPCはClosed PCなのでしょうか？、、、

コメント化しているコードは、インデックス2のシートに薬データをA列～F列に
CD 　薬名 　用法・用量 作用と効果 　使用上の注意　 副作用　　
等のデータがある時に抽出するものをと思いましたが説明が大変になるのでやめました。。。
全て名前がキーになります。（画像出力はG列にする必要があります）

Option Explicit
Sub Sample2()
Dim Pict_Folder As String, Extension As String
Dim Target_Pic, Target_Cel As String
Dim Err_msg As String, Target_shape
’Dim Medicine_txt, R
　　On Error Resume Next
　　Pict_Folder = "C:\Medicine_Data\"　　'PictureファイルのあるFolderアドレス
　　Extension = ".png"　　'Pictureファイルの種類
　　For Each Target_Pic In ActiveSheet.Range("B6:B14")　　 '画像名を入れる範囲
　　　　If Target_Pic.Value <> "" Then
　　　　　　Set Target_shape = ActiveSheet.Shapes.AddPicture(Filename:=Pict_Folder & Target_Pic.Value & Extension, _
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 LinkToFile:=False, SaveWithDocument:=True, Left:=0, Top:=0, Width:=0, Height:=0)
　　　　　　Target_Cel = Target_Pic.Offset(0, 4).Address　　'出力セル　F6~F14(画像名のあるセルの右に4つ目セル
　　　　　　Range(Target_Cel).Activate
　　　　　　With Target_shape
　　　　　　　　.ScaleWidth 1, msoTrue
　　　　　　　　.ScaleHeight 1, msoTrue
　　　　　　　　.LockAspectRatio = msoTrue
　　　　　　　　.Left = ActiveCell.Left
　　　　　　　　.Top = ActiveCell.Top
　　'セル内に画像サイズ調整
　　　　　　　　.Height = ActiveCell.Height - 4
　　　　　　　　If .Width > ActiveCell.Width Then .Width = ActiveCell.Width
　　'縦横を中央寄せ
　　　　　　　　.Left = .Left + (ActiveCell.Width - Target_shape.Width) / 2
　　　　　　　　.Top = .Top + (ActiveCell.Height - Target_shape.Height) / 2
　　　　　　End With
　　　　　　Set Target_shape = Nothing

　　'　　　　R = WorksheetFunction.Match(Target_Pic.Value, Sheets(2).Range("B:B"), 0)
　　'　　　　Medicine_txt = Sheets(2).Range("C" & R & ":F" & R).Value
　　'　　　　Range("C" & Target_Pic.Row & ":F" & Target_Pic.Row) = Medicine_txt

　　　　　　If Err.Number <> 0 Then
　　　　　　　　If Err.Number = 91 Then
　　　　　　　　　　Err_msg = Err_msg & Target_Pic.Address & " : セル：画像名：" & Target_Pic.Value & "：画像が見つかりません。" & vbCrLf
　　　　　　　　Else
　　　　　　　　　　Err_msg = Err_msg & Target_Pic.Address & " : セル ：画像名：" & Target_Pic.Value & "画像抽出でエラーが発生しました。" & vbCrLf
　　　　　　　　End If
　　　　　　　　Err.Clear
　　　　　　End If
　　　　End If
　　Next Target_Pic

　　If Err_msg <> "" Then
　　　　MsgBox Err_msg
　　Else
　　　　MsgBox " 画像抽出しました。"
　　End If
End Sub

Sub MyShape_Delete()
Dim shp As Shape
　　For Each shp In ActiveSheet.Shapes
　　　　If shp.Type = msoPicture Then shp.Delete
　　Next shp
End Sub

この回答へのお礼

クくくくく・・・・・！！！！、完璧です。有難うございました。青森の老人ホームを代表して感謝申し上げます！！！（最初　新除去プログラムでも画像が消えなかったが、メインの抽出画像プログラム入れ替えで中央などに画像がスパッと入るようになったら、画像除去が新除去プログラムで可能となりました）。感謝申し上げます。先生にさらに幸あることを神様に申し伝えます。

お礼日時：2019/11/19 07:19

No.11 回答者： Qchan1962 回答日時： 2019/11/22 22:17

MsgBox " 画像抽出しました。

"　を削除してください。
おそらくは、これ以上の回答、アドバイスは出ないと思いますので、問題がなければ
後の方の為に、スレッドを閉じてくださいね。

この回答へのお礼

大変　申し訳ありませんでした！　閉じます。

お礼日時：2019/11/23 04:23

No.9 回答者： moto_koukousei 回答日時： 2019/11/18 17:18

マクロを使わずにやる方法もあります。

http://officetanaka.net/excel/function/tips/tips …
この方法で、No.1,No.2,No.3,No.4,No.5,,,,といくつかの処方薬を選んで、それらの画像も切り替え、お薬の名称,主成分,服用の仕方,効能,副作用などを、それぞれの領域に表示させる（元データーは、別の領域に用意してあるとして）ことは、可能だと思います。

ただ、大きな問題が２つあります。　
❶　薬の情報であるので、（元データーを、別の領域に用意する）ときに誤ったら大変です。　何かの操作ミスで情報を書き換えてしまっても、それに気付くのはまずムリです。　以降、誤った情報を提供し続けることになりますが、それが間違い情報であることに気付くのはムリです。
❷　医薬品は新薬だけでなく、ジェネリックが次々発売になります。それらが出るたびに、（元データー)を入れて、リンクできるように、貼り付け先になるであろう[No.1,No.2,No.3,No.4,No.5,,,,]の入力欄のリストを書き直さないとなりません。
この手間は大変です。　もしかすると、エクセルの仕組みが分かっていて、その修正をできて、間違いが起きてないかを継承することが出来る人材が一人に限られているかもしれません。
おそらく、元データにする薬の酒類は100以上かもしれません。　それを、内容が間違いなく、うっかり末梢や書き換えが起きてないのか心配するのは、かなり大変です。

データベースを扱うのがEXCELよりも得意なものを使うのがイイかどうかという問題以前のような気がします。
私だったら、薬剤のメーカの添付文書をそのままプリントするか、適当なサイトから検索して、リンク先をブックマークしておき、そのブックマークのところを印刷する方法をとります。　ただ印刷内容は老人施設の入所者にとっていらない情報ばかりになります。　とても無駄なことのように思います。　それならいっそのこと、（薬の一覧と写真＆説明文）を冊子にして、２～５冊ほど作ってだれでも見える状態にしておき、各人には、[8ページのNo.23 サーティカン錠0.75mg、5ページのNo.16　バイアスピリン錠100mg、5ページのNo.18 セスデンカプセル30mg、15ページのNo.48 クアゼパム錠15mg]という文字情報だけをメモプリントして提供した方が良さそうに思います。

http://www.rad-ar.or.jp/siori/index.html

No.8 回答者： Qchan1962 回答日時： 2019/11/18 12:10

#5です。

＃5に挙げたように他の制御を鑑みると皆さんの回答に賛成です。扱いデータの重要性を考慮し検討してください。、、が、
今の現状を想像するに説明表を渡すのが目的で、管理的なものを必要としていない（他の方法で行っている）のかもしれませんね。
それについて、意見を述べる立場ではないので、ご質問（補足）について回答いたします。
環境、フォーマットなど具体的にされれば、薬データからリストを作り入力支援なども可能で具体的に書けますが、、、続きと言う事で、、

B6セル～B14セルに画像名があります。なければ取りに行きません。"B6:B14"を変えると対象範囲が変わります。
画像はC:\Medicine_Dataのフォルダにすべて入れます。
画像ファイルの種類は.pngです。.pngなどに変更するとその種類になります。
Target_Cel = Target_Pic.Offset(0, 4).Addressの4を3にするとE列になります。

Option Explicit
Sub Sample2()
Dim Pict_Folder As String, Extension As String
Dim Target_Pic, Target_Cel As String
Dim Err_msg As String
　　On Error Resume Next
　　Pict_Folder = "C:\Medicine_Data\"　　'PictureファイルのあるFolderアドレス
　　Extension = ".png"　　'Pictureファイルの種類
　　For Each Target_Pic In ActiveSheet.Range("B6:B14")　　'画像名を入れる範囲
　　　　If Target_Pic.Value <> "" Then
　　　　　　Target_Cel = Target_Pic.Offset(0, 4).Address　　'出力セル　F6~F14(画像名のあるセルの右に4つ目セル
　　　　　　With ActiveSheet.Pictures.Insert(Pict_Folder & Target_Pic.Value & Extension)
　　　　　　　　.Top = Range(Target_Cel).Top
　　　　　　　　.Left = Range(Target_Cel).Left
　　　　　　　　ActiveSheet.Shapes(.Name).LockAspectRatio = msoFalse
　　'画像サイズは指定なし（そのまま）
　　　　　　End With
　　　　　　If Err.Number <> 0 Then
　　　　　　　　If Err.Number = 91 Then
　　　　　　　　　　Err_msg = Err_msg & Target_Pic.Address & " : セル：画像名：" & Target_Pic.Value & "：画像が見つかりません。" & vbCrLf
　　　　　　　　Else
　　　　　　　　　　Err_msg = Err_msg & Target_Pic.Address & " : セル ：画像名：" & Target_Pic.Value & "画像抽出でエラーが発生しました。" & vbCrLf
　　　　　　　　End If
　　　　　　　　Err.Clear
　　　　　　End If
　　　　End If
　　Next Target_Pic

　　If Err_msg <> "" Then
　　　　MsgBox Err_msg
　　Else
　　　　MsgBox " 画像抽出しました。"
　　End If
End Sub

画像を削除も面倒だと思うので、追加です。
アクティブシートのすべての画像を削除します。
ロゴなどを画像として表示している場合は、削除されるので注意が必要です。

Sub MyShape_Delete()
　Dim shp As Shape
　For Each shp In ActiveSheet.Shapes
　　If shp.Type = msoPicture Then shp.Delete
　Next shp
End Sub

No.7 回答者： grumpy_the_dwarf 回答日時： 2019/11/18 11:36

Excelでやろうなんてのは完全に不適材不適所の極みですが、Accessでも画像の格納は「できなくはない」レベルなのであまり推奨しません。

昔から医療系で人気のあるファイルメーカーProあたりがオススメですね。

No.6 回答者： GooUserラック 回答日時： 2019/11/17 21:26

１から作るのはとても大変なので以下のようなサイトから扱っている薬のみの情報をエクセルやワードに張付けて不要な部分を削除したものを薬ごとにＰＤＦ化して置いて、必要な物を印刷すれば良いと思います。

https://www.qlife.jp/meds/newsmed_1/rx_list_1.html

No.5 回答者： Qchan1962 回答日時： 2019/11/17 14:38

Excelで実現するなら、VBAを導入する必要があります。

＞薬剤情報提供ホルダーにお薬の各　効能、副作用、画像を集めて入れておいたとき
そうですね、画像貼り付けなどはNameプロパティを使用すれば、問題ありませんし、データの絞り込みなども
それほど難しいプロセスは必要ないと思いますが、
書類の性質上、履歴を残す必要があると思います。また、システム的なトラブルを回避するために
外部メディアに残す必要も、NAS程度ならまだ良いですが、クラウドなどですと、個人情報のレベルも高いデータなので
セキュリティ対策を講じる必要もありますね。
ベースのExcelもシステムアプリケーションとしてリボン表示をカスタムしたりして、専用の動作以外できないように
開発設定する必要はあるかと思います。
扱い件数、数量も多くないので紙ベースの管理で行うにしても、全体の構築を丁寧に考える必要があると思います。

さっくり考えると
入力シート（患者データで履歴表示がされる）薬選択は分類などで基本リスト化
提供用紙（行の増減を想定した可変フォーマット）’可変にする事や繰り返し処理を想定して可変部分に統合セルは使わない。
お薬、最低でもIDやCDと名前、（CDなどに分類情報を入れる）IDやCDに紐づいたデータ各種（外部ファイルでも）（画像は、ファイルベースで良い）
患者データベース、運用者データなど、、、
仕様書、環境構築、VBA、ファイルの限定仕様（アプリ化）、デバッグ、（簡単なヘルプ）、、、
VBA初心者が勉強しながら一人で行うと、、かける時間で違いますが、1,2か月、、かかるかな？

使いまわしのサンプルがあったので内容を少し変更して例を掲示します。。画像をセルに入れるサンプル（Excel　VBA)

（ActiveSheet）の　B6セルに　お薬名A　がある時、C:\Medicine_Data フォルダー内の　同じ名前（お薬名A）の画像（png）をF6：I9セルに表示する。

Option Explicit
Sub Sample1()
Dim Pict_Nama As String
Dim Target_Cel, Taget_W, Taget_H
　　On Error Resume Next
　　Pict_Nama = ActiveSheet.Cells(6, 2).Value　’B6セル
　　Target_Cel = ActiveSheet.Cells(6, 2).Offset(0, 4).Address　’F6セル
　　Taget_W = Range(Target_Cel).Offset(0, 3).Address
　　Taget_H = Range(Target_Cel).Offset(3, 0).Address
　　With ActiveSheet.Pictures.Insert("C:\Medicine_Data\" & Pict_Nama & ".png")
　　　　.Top = Range(Target_Cel).Top
　　　　.Left = Range(Target_Cel).Left
　　　　ActiveSheet.Shapes(.Name).LockAspectRatio = msoFalse
　　　　.Width = Range(Target_Cel & ":" & Taget_W).Width
　　　　.Height = Range(Target_Cel & ":" & Taget_H).Height
　　End With
　　If Err.Number <> 0 Then
　　　　If Err.Number = 91 Then
　　　　　　MsgBox "Err.Number：" & Err.Number & " 画像が見つかりません。"
　　　　Else
　　　　　　MsgBox Err.Number & " 画像抽出でエラーが発生しました"
　　　　End If
　　　　Err.Clear
　　End If
End Sub

No.4 回答者： めぐみん_ 回答日時： 2019/11/17 11:48

問題は『ポッと出したい画像ファイルの総数と管理（追加・削除・更新）』の方ではなくて？

おおよそどの程度あるのかはわかりませんが、それなりにある為薬局などでも相応に費用をかけているのだろうと思いますよ。

その数が薬局ほどではないにしろ1つの処方なら１枚印刷出来ればいいでしょうが、複数の処方についてどのように印刷を区切るのかって点も気にはなりますね。
機械（？）でないにしろシステム的にどう組むのか疑問点などを上に挙げて『お手上げです！』と報告されたら如何でしょう。
それが患者（入居者やその家族）に対する誤処方防止をしなければならない立場であると考えます。

No.3 回答者： タマタマポチ 回答日時： 2019/11/17 07:47

＃1さんも書いていらっしゃいますが、それはAccessの案件です。

Excelでは、できないとはいいませんが無理がある。
画像を扱うとかなり重くなります。
　　
Accessはややとりつきにくいですが、頑張ってトライしてみて下さい。
ネット上にはテンプレートもあります、それが使えれば便利ですが･･･

No.2 回答者： chonami 回答日時： 2019/11/17 06:56

https://qiita.com/Cremokoroah/items/bb3bd9777604 …

こちらなどはどうですか？