FC2ブログ

Excelシートの指定範囲を画像保存する

Excelで作ったシートを帳票に張り付けたい、、、がそんなこと出来ないので、画像保存して貼り付けよう!
というわけで、Excelシートの指定範囲を画像保存するロジックを作ってみました。

※インデントを全角で付けるとコピペできないので止めました。
 見難いですがVSにコピペすれば大丈夫です(笑)
※Microsoft.Office.Interop.Excel の参照設定を忘れずに!
※環境:VisualStudio2015 / Office2019

Private oExcel As Excel.Application = Nothing
Private oBook As Excel.Workbook = Nothing
Private oSheet As Excel.Worksheet = Nothing
Private oRange As Excel.Range = Nothing
Private oRows As Excel.Range = Nothing
Private oExcelActiveWindow As Excel.Window = Nothing

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim idataPic As IDataObject = Nothing
Dim bmpData As Bitmap = Nothing

Try

Cursor.Current = Cursors.WaitCursor

oExcel = New Excel.Application

With oExcel
.Application.Visible = False
.DisplayAlerts = False
End With


With oExcel
'ファイル:オープン
oBook = .Workbooks.Open("*** ココにExcelファイルのパスを入れて下さい ***")
End With

With oBook
'ワークシート:オープン
oSheet = .Worksheets(1)
End With

With oSheet
'ワークシート:Select
.Select()

'Range:Select
oRange = .Range(.Cells(2, 2), .Cells(10, 10))
End With

' 枠線:非表示
oExcelActiveWindow = oExcel.ActiveWindow
With oExcelActiveWindow
.DisplayGridlines = False
End With


'--------------------------------------------------
' Excel:選択範囲⇒クリップボード⇒画像保存
'--------------------------------------------------

oRange.CopyPicture(Excel.XlPictureAppearance.xlScreen, Format:=Excel.XlCopyPictureFormat.xlBitmap)

idataPic = Clipboard.GetDataObject()

If idataPic.GetDataPresent(DataFormats.Bitmap) Then
bmpData = idataPic.GetData(DataFormats.Bitmap)

bmpData.Save("*** ココにExcelファイルのパスを入れて下さい ***".Text.Replace("xlsm", "jpg"), System.Drawing.Imaging.ImageFormat.Jpeg)
End If

oBook.Close(SaveChanges:=False)


MessageBox.Show("完了!", "画像変換", MessageBoxButtons.OK, MessageBoxIcon.Information)

Catch ex As System.IO.FileNotFoundException

MessageBox.Show("エラー!" & vbCrLf & ex.Message, "画像変換", MessageBoxButtons.OK, MessageBoxIcon.Error)

Finally

'--------------------------------------------------
' Excel設定:戻す
'--------------------------------------------------

'If Not oExcelActiveWindow Is Nothing Then
' With oExcelActiveWindow
' .DisplayGridlines = True
' End With
'End If

'If Not oExcel Is Nothing Then
' With oExcel
' .Application.Visible = True
' .DisplayAlerts = True
' End With
'End If


'--------------------------------------------------
' Excelオブジェクト:破棄
'--------------------------------------------------

idataPic = Nothing
bmpData = Nothing

If Not oExcelActiveWindow Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oExcelActiveWindow)
oRange = Nothing
End If

If Not oRange Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oRange)
oRange = Nothing
End If

If Not oSheet Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oSheet)
oSheet = Nothing
End If

If Not oBook Is Nothing Then
'oBook.Close(False)
System.Runtime.InteropServices.Marshal.ReleaseComObject(oBook)
oBook = Nothing
End If

If Not oExcel Is Nothing Then
oExcel.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(oExcel)
oExcel = Nothing
End If

Cursor.Current = Cursors.Default

End Try

End Sub
関連記事

テーマ : パソコンサポート
ジャンル : コンピュータ

コメントの投稿

非公開コメント

検索フォーム
最新記事
カテゴリ
全記事表示リンク

全ての記事を表示する

最新コメント
プロフィール

ITLife

Author:ITLife
システム葵新井聡太です。
東京都東村山市に生まれ、ここで育ち、ここで結婚し、システムエンジニア一筋で十数年やってきました。
ここでは主に、パソコンを中心にITに関わることを備忘録として残していきたいと思います。
少しでも来ていただいた方のお役に立てたら幸いです。
m(_ _)m

p.s
ここで紹介している内容は一例です。すべては、自己責任でお願いします。

カレンダー
02 | 2019/03 | 04
- - - - - 1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31 - - - - - -
訪問数
月別アーカイブ
リンク