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
というわけで、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
