エクセルのシートに画像を表示
 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
Excelのシートに画像を表示（３方法）及びサイズ変更　　　　(339)
動作確認 ： WindowsXP(SP2)　VB6.0(SP6) /　Excel 2000　Excel 2002　Excel 2007
Form に CommandButton ２個と PictureBox を１個貼り付けておいて下さい。
そして適当な画像を用意しておいて下さい。
　 まず、VBからExcel及びWordを操作する時の注意事項を見て下さい

Option Explicit　　
Private Sub Command1_Click()
'★プロジェクト→参照設定でMicrosoft Excel *.* ObjectLibraryに
'　チェックを入れておいて下さい。
'==================================================================
'Excel の起動処理
　 '基本的な設定は[VBからエクセルを操作する]を参照して下さい。
　 Dim xlApp　　As Excel.Application
　 Dim xlBook　 As Excel.Workbook
　 Dim xlSheet　As Excel.Worksheet
　 Set xlApp = CreateObject("Excel.Application")
　 Set xlBook = xlApp.Workbooks.Add '転載禁止
　 Set xlSheet = xlBook.Worksheets(1)
　 xlApp.Visible = True

'==================================================================
'Excelに表示する画像の準備
　 Dim MyPath　 As String
　 '環境に合わせて変更して下さい(表示するファイルのパス）
　 MyPath = CreateObject("Scripting.FileSystemObject" _
　　　　　　　　　　　　 ).GetAbsolutePathName("..\Image.jpg") '転載禁止
　 'PictureBox に画像ファイルを読込
　 Set Picture1.Picture = LoadPicture(MyPath)
　 DoEvents
　 '上記の画像をクリップボードにコピー
　 Clipboard.Clear '転載禁止
　 Clipboard.SetData Picture1.Picture
　 DoEvents

'==================================================================
'Excel を操作部分

'１．Pictureオブジェクトを使って表示
　 'Excel2002 からの機能です。
　 '簡単だけど画像サイズが元のサイズより大きく表示される
　 'セルB2の位置に指定の画像を挿入
　 xlSheet.Range("B2").Select '転載禁止
　 xlSheet.Pictures.Insert(MyPath).Select

'２．クリップボード経由での貼付け
　 'こちらは元のサイズで表示します。
　 xlSheet.Range("H2").Select '転載禁止
　 'セルH2の位置に貼付け
　 xlSheet.Paste '転載禁止

'==================================================================
'下記コードはこのサンプルとは直接、関係ありません。
'動作確認の為に Excel を５秒間表示して置く為のものです。
　 Dim lngSt As Long
　 lngSt = Timer
　 Do While Timer - lngSt < 5
　　　DoEvents
　 Loop
'==================================================================
'終了処理
　 '保存時の問合せを非表示に設定
　 xlApp.DisplayAlerts = False

　 Set xlSheet = Nothing
　 xlBook.Close
　 Set xlBook = Nothing
　 xlApp.Quit
　 Set xlApp = Nothing
End Sub


画像を指定のサイズで表示及び拡大・縮小表示
Private Sub Command2_Click()
'★プロジェクト→参照設定でMicrosoft Excel *.* ObjectLibraryに
'　チェックを入れておいて下さい。
'==================================================================
'Excel の起動処理
　 '基本的な設定は[VBからエクセルを操作する]を参照して下さい。
　 Dim xlApp　　As Excel.Application
　 Dim xlBook　 As Excel.Workbook
　 Dim xlSheet　As Excel.Worksheet
　 Set xlApp = CreateObject("Excel.Application")
　 Set xlBook = xlApp.Workbooks.Add
　 Set xlSheet = xlBook.Worksheets(1)
　 xlApp.Visible = True

'==================================================================
'Excelに表示する画像の準備
　 Dim MyPath　 As String
　 '環境に合わせて変更して下さい(表示するファイルのパス）
　 MyPath = CreateObject("Scripting.FileSystemObject" _
　　　　　　　　　　　　 ).GetAbsolutePathName("..\Image.jpg")
　 'PictureBox に画像ファイルを読込
　 Set Picture1.Picture = LoadPicture(MyPath)
　 DoEvents
　 '上記の画像をクリップボードにコピー
　 Clipboard.Clear '転載禁止
　 Clipboard.SetData Picture1.Picture
　 DoEvents

'==================================================================
'Excel を操作部分
　 '同じ画像を３個３方法で貼付け
　 xlSheet.Paste Destination:=xlSheet.Range("B2") '転載禁止

　 xlSheet.Range("G2").Select
　 xlSheet.Paste '転載禁止

　 '形式を選択して貼り付ける場合(今回は引数を省略してすべてを貼付)
　 xlSheet.Range("B17").PasteSpecial '転載禁止

　 '拡大表示（1.25 = 拡大率(1.25倍)で指定）
　 xlSheet.Shapes("Picture 2").Select
　 xlSheet.Shapes("Picture 2").ScaleWidth 1.25, 0, 0 '転載禁止
　 xlSheet.Shapes("Picture 2").ScaleHeight 1.25, 0, 0

　 '縮小表示
　 xlSheet.Shapes("Picture 3").Select '転載禁止
　 xlSheet.Shapes("Picture 3").ScaleWidth 0.75, 0, 0 '転載禁止
　 xlSheet.Shapes("Picture 3").ScaleHeight 0.75, 0, 0

'==================================================================
'下記コードはこのサンプルとは直接、関係ありません。
'動作確認の為に Excel を５秒間表示して置く為のものです。
　 Dim lngSt As Long
　 lngSt = Timer
　 Do While Timer - lngSt < 5
　　　DoEvents '転載禁止
　 Loop
'==================================================================
'終了処理
　 '保存時の問合せを非表示に設定
　 xlApp.DisplayAlerts = False
　 Set xlSheet = Nothing
　 xlBook.Close
　 Set xlBook = Nothing
　 xlApp.Quit
　 Set xlApp = Nothing
End Sub
　
下記はExcel上に表示したPictureにVBから指定の画像を表示する方法です。　　　(230)
Form には CommandButton を１個貼り付けておいて下さい。
別途、Excel上にimageコントロールとLabelコントロールを貼り付けておいて下さい。
又、下記マクロをTest1.xlsに作成しておいて下さい。
　　 Option Explicit　　
Private Sub Command1_Click()
'★プロジェクト→参照設定でMicrosoft Excel *.* ObjectLibraryに
'　チェックを入れておいて下さい。
'==================================================================
'Excel の起動処理
　 '基本的な設定は[VBからエクセルを操作する]を参照して下さい。
　 Dim xlApp　　As Excel.Application
　 Dim xlBook　 As Excel.Workbook
　 Dim xlSheet　As Excel.Worksheet
　 Set xlApp = New Excel.Application
　 Set xlBook = xlApp.Workbooks.Open(myPath & "Test.xls")
　 Set xlSheet = xlBook.Worksheets(1)
　 xlApp.Visible = True '転載禁止
'==================================================================
'下記コードはこのサンプルとは直接、関係ありません。
'動作確認の為に Excel を2秒間表示して置く為のものです。
　 Dim lngSt As Long
　 lngSt = Timer '転載禁止
　 Do While Timer - lngSt < 2
　　　DoEvents
　 Loop
'==================================================================
'Excel を操作部分
　 'Excelのマクロを起動転載禁止
　 xlApp.Run "Test.xls!SetPicture", myPath & "image.jpg"

　 xlApp.Run "Test.xls!SetLabelCaption", "愛犬のユキです。"

'==================================================================
'下記コードはこのサンプルとは直接、関係ありません。
'動作確認の為に Excel を５秒間表示して置く為のものです。
　 'Dim lngSt As Long
　 lngSt = Timer
　 Do While Timer - lngSt < 5
　　　DoEvents
　 Loop
'==================================================================
'終了処理
　 '保存時の問合せを非表示に設定
　 xlApp.DisplayAlerts = False
　 Set xlSheet = Nothing
　 xlBook.Close
　 Set xlBook = Nothing
　 xlApp.Quit
　 Set xlApp = Nothing
End Sub

'別途 Test1.xls ファイル内に下記のようなマクロを作成しておいて下さい。
'詳しくは添付のTest1.xls を見て下さい。
'Public Sub SetPicture(PicFile As String)
'　　With Sheet1.Image1
'　　　　.AutoSize = True
'　　　　.Picture = LoadPicture(PicFile)
'　　End With
'End Sub
'
'Public Sub SetLabelCaption(Caption As String)
'　　Sheet1.Label1.Caption = Caption
'End Sub
時々、掲示板に質問がありますので作成して見ました。今回はExcelに表示しておりますが、Word
にも応用（一部コードを変更）できるかと思います。


2003/02/17
2006/12/12


VBレスキュー(花ちゃん)
Visual Basic6.0　 VB6.0