Excel に貼り付けた図をデータベース管理したい

質問

行いたいこと
Excel2003 にてシートへ図の挿入された写真や絵などをデータベース管理したい。
詳細
・図形をシートの指定場所へ図の挿入
・指定場所からはみださないように体裁を整え
・VBAにより、ボタンで他の文書と同様登録をする。
・ネットワークに繋がってる他の場所からそのデータをデータベースから取り込み。
・シートの指定場所へ表示する。

以上のようなことは可能でしょうか
教えてください。
よろしくお願いいたします。

、

回答No.2

DOUGLAS_

＞Excel2003 にてシートへ図の挿入された
＞写真や絵などをデータベース管理したい。
とのことですが、その ワークシート には、サムネイル（縮小加工された ファイルサイズ の小さな画像）ではなくて、元々の ファイルサイズ の大きな画像を貼り付けられるのでしょうか？

　「画像の管理」ということになれば、画像そのものは「ネットワークに繋がってる他の場所」に置いておいて、
１）ファイル名 を選択すると、その画像を「ネットワークに繋がってる他の場所」から読み込んで表示する
とか、あるいは、
２）ワークシート には サムネイル を表示しておく
というような操作が有効かと存じます。

　(１) の場合は、ＶＢＡ になりますし、(２) の場合は、Excel ではなくて、それに特化した ソフト で画像一覧を閲覧するようなことが普通でしょうか。

　１つの ブック に画像そのものを並び立てると、ブック の サイズ が異常に大きくなり、開かなくなるのが落ちですか。

--------------------------------------------------

　いずれの例も
Const myPath As String = "\\network\address\folder\"
のところに ネットワーク アドレス の フルパス を記入し、最後に「\」記号を入れてください。

１）の例
　当該 ワークシート の シートモジュール に下記を コピペ してお試しください。
　先ず「MkList」を実行しておいて、A1 セル の リスト から画像の名前を選択すると、C1 セル に画像を表示します。
　表示された画像は サムネイル ではなくて、「ネットワークに繋がってる他の場所」の 画像ファイル をそのまま読み込んでいます。

Option Explicit
Option Compare Text
Const myPath As String = "\\network\address\folder\"
Sub MkList()
　Dim MyName As String
　Dim MyList As String
　On Error Resume Next
　ActiveSheet.Pictures("表示用").Delete
　On Error Resume Next
　MyName = Dir(myPath & "*.jpg")
　Do While MyName <> ""
　　MyList = MyList & "," & Replace(MyName, ".jpg", "")
　　MyName = Dir
　Loop
　Application.EnableEvents = False
　With Range("A1").Validation
　　.Delete
　　.Add Type:=xlValidateList, Formula1:=Left(MyList, 911)
　End With
　Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
　If Target.Address <> "$A$1" Then Exit Sub
　Application.ScreenUpdating = False
　Range("C1").Select
　With ActiveSheet.Pictures
　　On Error Resume Next
　　.Item("表示用").Delete
　　.Insert(myPath & Range("A1").Value & ".jpg").Select
　　On Error GoTo 0
　End With
　With Selection.ShapeRange
　　.Name = "表示用"
　　.LockAspectRatio = msoTrue
　　.Height = Range("C1:C7").Height
　End With
　Range("A1").Select
　Application.ScreenUpdating = True
End Sub

--------------------------------------------------

２）の例
　こちらは、
http://okwave.jp/qa/q5744704.html
の #3 さんのご回答を参考にさせていただきました。
　mitarashi 様、無断借用ご容赦を　<(_ _)>

　標準ジュール に下記を コピペ してお試しください。
　ワークシート に「ネットワークに繋がってる他の場所」にある 画像ファイル の サムネイル と ファイル名 を羅列し、サムネイル画像 を クリック すると、元の写真が規定の アプリケーション（私の環境では、JPG ファイル の場合は Internet Explorer でした）によって開かれます。

Option Explicit
Option Compare Text
Sub MkThumbnail()
　Const myPath As String = "\\network\address\folder\"
　Dim MyName As String
　Dim i As Long
　Application.ScreenUpdating = False
　MyName = Dir(myPath & "*.jpg")
　Do While MyName <> ""
　　i = i + 1
　　Range("B1").Select
　　ActiveSheet.Pictures.Insert(myPath & MyName).Select
　　With Selection.ShapeRange
　　　.Name = "表示用"
　　　.LockAspectRatio = msoTrue
　　　.Height = Range("C1:C7").Height
　　End With
　　'xlBitmapの方が若干ファイルサイズが小さいですが、2007では、xlPictureしか有効でないという情報もありますのでコメントアウトして置いておきます
　　Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 'xlPicture
　　Cells(Int((i - 1) / 4) * 9 + 1, ((i - 1) Mod 4) * 4 + 1).Select
　　Cells(Int((i - 1) / 4) * 9 + 8, ((i - 1) Mod 4) * 4 + 1).Value = Replace(MyName, ".jpg", "")
　　'ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)", Link:=False, DisplayAsIcon:=False
　　ActiveSheet.PasteSpecial Format:="ビットマップ", Link:=False, DisplayAsIcon:=False
　　ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=myPath & MyName
　　ActiveSheet.Pictures("表示用").Delete
　　MyName = Dir
　Loop
　Application.ScreenUpdating = True
End Sub