tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
VB2010からExcelのセル上に画像を表示及び拡大・縮小(VB.NET) ( No.10 )  [親スレッドへ]
日時: 2012/06/06 19:02
名前: VBレスキュー(花ちゃん)

***********************************************************************************
* カテゴリー:[エクセル][][]                                                      *
* キーワード:Excel VBA,Excel2010,画像を表示,拡大,縮小,Pictureオブジェクト        *
***********************************************************************************
'===================================================================================================
'投 稿 日:2012.05.05
'投 稿 者:VBレスキュー(花ちゃん)
'タイトル:VB2010 から Excel のセル上に画像を表示及び拡大・縮小
'========1=========2=========3=========4=========5=========6=========7=========8=========9=========0

Private Sub Button8_Click(sender As System.Object, e As System.EventArgs) Handles Button8.Click
   Call ExcelOpen("", "")     '新規ファイルをオープンして、Excel を起動
   '==================== セル上に画像を表示及び拡大・縮小 =======================

   '-------------------- 下記のVB6.0用コードを移植 ---------------------------
   ' http://hanatyan.sakura.ne.jp/vbhlp/Excel12.htm
      '1.Pictureオブジェクトを使って表示
      'xlSheet.Range("B2").Select()
      'xlSheet.Pictures.Insert(MyPath).Select()

      '2.クリップボード経由での貼付け
      'xlSheet.Range("H2").Select()
      'xlSheet.Paste()
   '--------------------------------------------------------------------------

   '1.Pictureオブジェクト(隠しオブジェクト)を使っての表示
   Dim myPath As String = System.IO.Path.GetFullPath(".\Test.gif")
   Dim xlRange As Excel.Range
   xlRange = xlSheet.Range("B2")
   Dim xlPictures As Excel.Pictures
   Dim xlPicture As Excel.Picture
   'Debug.Print(TypeName(xlSheet.Pictures))    'Pictures 
   '面倒でも下記のように変数に受けないと解放されない
   xlPictures = DirectCast(xlSheet.Pictures, Excel.Pictures)
   xlPicture = xlPictures.Insert(myPath)
   'Excel 2007では画像の挿入位置指定が下記のようにしないと指定できません。
   With xlPicture
      .Top = CDbl(xlRange.Top)
      .Left = CDbl(xlRange.Left)
   End With
   MRComObject(xlPicture)
   MRComObject(xlPictures)
   MRComObject(xlRange)
   'テストの為1秒間表示
   System.Threading.Thread.Sleep(1000)

    ''2.Web 上の画像を指定して、Pictureオブジェクト(隠しオブジェクト)を使っての表示
   myPath = "http://www.hanatyan.sakura.ne.jp/toppicture.gif"
   xlRange = xlSheet.Range("I2")
   xlPictures = DirectCast(xlSheet.Pictures, Excel.Pictures)
   xlPicture = xlPictures.Insert(myPath)
   With xlPicture
      .Top = CDbl(xlRange.Top)
      .Left = CDbl(xlRange.Left)
   End With
   MRComObject(xlPicture)
   MRComObject(xlPictures)
   MRComObject(xlRange)
   'テストの為1秒間表示
   System.Threading.Thread.Sleep(1000)

   '3.Web 上の画像を指定して、Shapes.Add メソッドを使っての表示
   'Excel 2010 で Pictures.Insert メソッドを使用して図をワークシートに挿入すると
   '図がリンクオブジェクトとして挿入される
   'http://support.microsoft.com/kb/2396509/ja
   myPath = "http://www.hanatyan.sakura.ne.jp/toppicture.gif"
   Dim xlShapes As Excel.Shapes
   xlRange = xlSheet.Range("I15")
   xlShapes = xlSheet.Shapes
   Dim xlShape As Excel.Shape
   '画像のサイズが前もって解らない場合は、適当なサイズで仮取得(縦横共 100ピクセルで)
   xlShape = xlShapes.AddPicture(Filename:=myPath, _
      LinkToFile:=MsoTriState.msoFalse, SaveWithDocument:=MsoTriState.msoTrue, _
      Left:=CSng(xlRange.Left), Top:=CSng(xlRange.Top), Width:=CSng(100), Height:=CSng(100))
   '図のサイズを元のサイズに戻します
   With xlShape
      .ScaleHeight(1.0!, MsoTriState.msoTrue)
      .ScaleWidth(1.0!, MsoTriState.msoTrue)
   End With
   MRComObject(xlShape)
   MRComObject(xlShapes)
   MRComObject(xlRange)
   'テストの為1秒間表示
   System.Threading.Thread.Sleep(1000)

   '4.クリップボード経由での貼付け
   '下記のリンクの画像をクリップボードにコピーしておいてから実行して下さい。
   'http://www.hanatyan.sakura.ne.jp/toppicture.gif
    Dim iData As IDataObject = Clipboard.GetDataObject()
    'クリップボードにBMPファイルがあれば
   If iData.GetDataPresent(DataFormats.Bitmap) = False Then
      'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。
      MessageBox.Show(Me, "クリップボード上に画像がありませんので、すぐにコピーして下さい。")
   End If
   xlRange = xlSheet.Range("M2")
   xlRange.Select()
   xlSheet.Paste()
   MRComObject(xlRange)
   'テストの為1秒間表示
   System.Threading.Thread.Sleep(1000)

  '5.拡大表示(1.25 = 拡大率(1.25倍)で指定)
   xlShapes = xlSheet.Shapes
   xlShape = xlShapes.Item(1)
   xlShape.Select()
   xlShape.ScaleWidth(1.25, MsoTriState.msoFalse, MsoScaleFrom.msoScaleFromTopLeft)
   xlShape.ScaleHeight(1.25, MsoTriState.msoFalse, MsoScaleFrom.msoScaleFromTopLeft)
   MRComObject(xlShape)
   MRComObject(xlShapes)
   'テストの為1秒間表示
   System.Threading.Thread.Sleep(1000)

   '6.縮小表示
   xlShapes = xlSheet.Shapes
   xlShape = xlShapes.Item(2)
   xlShape.Select()
   xlShape.ScaleWidth(0.75, MsoTriState.msoFalse, MsoScaleFrom.msoScaleFromTopLeft)
   xlShape.ScaleHeight(0.75, MsoTriState.msoFalse, MsoScaleFrom.msoScaleFromTopLeft)
   MRComObject(xlShape)
   MRComObject(xlShapes)
   'テストの為1秒間表示
   System.Threading.Thread.Sleep(1000)

   '=============================================================================
   'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行
   Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False)  'False の場合保存しないで終了
   'Excel.EXE がタスクマネージャに残っていないか調査(実使用時は必要なし)
   Call ProcessCheck()
End Sub



 [スレッド一覧へ] [親スレッドへ]