none
vb.net是否可以將excel裡面某個cell存放的圖形擷取出來,然後另存新檔? RRS feed

  • 問題

  • 我在某個cell插入圖片,存成xls檔之後
    是否可以用其他程式 , 譬如vb或vb.net
    將某個cell的圖片擷取出來並存成檔案
    請前輩指點一下
    謝謝
    2006年10月12日 上午 07:35

解答

  • 基本上 Office 的剪貼簿都是延後提出,若是送到剪貼簿的格式沒有標準格式,則必須用更複雜的方式處理。Word 會填入 System.Drawing.Bitmap ,但是 Excel 只有部分圖檔會填入,部份不會。

     

    什麼意思嗎?先看看線上手冊關於 My.Computer.Clipboard 物件成員 的描述:

    ContainsImage  判斷剪貼簿是否包含影像。這個方法只適用於伺服器應用程式

     

    延後提出是不先把資料往剪貼簿送,而是告訴剪貼簿說,軟體提供哪些格式,等到剪貼簿收到貼上時,再把需求轉給軟體,這時軟體才把指定格式的資料送給剪貼簿,所以這類軟體就是屬於上面寫的伺服器應用程式

     

    若要抓到所有圖檔,你必須用 System.Windows.Forms.Clipboard.GetDataObject.GetFormats 取得格式,例如說不提供 System.Drawing.Bitmap 的圖檔,可能格式是:

    Code Snippet

    '(0): "Office Drawing Shape Format"

    '(1): "EnhancedMetafile"

    '(2): "MetaFilePict"

    '(3): "PNG+Office Art"

    '(4): "JFIF+Office Art"

    '(5): "GIF+Office Art"

    '(6): "PNG"

    '(7): "JFIF"

    '(8): "GIF"

    '(9): "ActiveClipBoard"

     

    再用:

    Dim ms As MemoryStream = System.Windows.Forms.Clipboard.GetDataObject.GetData("PNG", True)

    取回資料流,再用:

    Dim picImage As System.Drawing.Image = System.Drawing.Image.FromStream(ms)

     

    這部份比較複雜,那個簡單的範例不能完整包含。我自己是做個 ClipboardEx 類別來處理。 

    2007年3月30日 上午 03:39
    版主

所有回覆

  • 想必一定是沒有 =.=....
    2006年10月12日 上午 07:57
    版主
  • 拍謝

    忘了用搜尋

    下次改進 ^^

    2006年10月12日 上午 08:57
  • 我參考您的範例程式,寫了一段測試程式

    首先用excel 2000編輯了一個檔案,在sheet1放上1張jpg圖形

    在sheet2放上2張jpg圖形, 圖形都是用  /插入/從檔案/ 的方式放到工作表上

    然後用 vs 2005 開了一個vb.net專案

    當我處理sheet1時,shapes裡面有1個物件,但是程式碼copy到剪貼簿卻被認為not contianImage

    然後我去小畫家把圖形貼上,是有圖形的, 我故意複製一段文字把剪貼簿清空

    當我處理sheet2時,shapes裡面有2個物件,但是程式碼copy到剪貼簿卻被認為not contianImage

    然後我去小畫家把圖形貼上,是有圖形的,可是卻是sheet1的圖形,就是跟剛剛圖形相同

    狠奇怪....是哪裡出錯了嗎?

    程式碼如下

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
            Dim xlApp As Excel.Application
            Dim xlBooks As Excel.Workbooks
            Dim xlBook As Excel.Workbook
            Dim xlSheets As Excel.Sheets
            Dim xlSheet As Excel.Worksheet

            xlApp = CreateObject("Excel.Application")
            xlApp.DisplayAlerts = False 
            xlBooks = xlApp.Workbooks
            xlBook = xlBooks.Open("c:\test.xls")
            xlSheets = xlBook.Worksheets

            xlSheet = xlSheets.Item(1)

            Dim count As Integer = xlSheet.Shapes.Count
            MsgBox("偵測到可能有 " & count & " 張圖形")
            Dim i, j As Integer
            Dim strPictureName As String
            Dim pic As Image

            For i = 1 To count

                Select Case xlSheet.Shapes.Item(i).Type

                    Case Office.MsoShapeType.msoPicture

                        xlSheet.Shapes.Item(i).Select()
                        xlApp.Selection.copy()
                        'MsgBox(xlSheet.Shapes.Item(i).Type)

                        If My.Computer.Clipboard.ContainsImage() Then
                            j += 1
                            strPictureName = "c:\" & j.ToString("00000") & ".jpg"
                            pic = My.Computer.Clipboard.GetImage()
                            pic.Save(strPictureName, Imaging.ImageFormat.Jpeg)
                            PictureBox1.Image = pic
                            PictureBox1.Refresh()
                            Threading.Thread.Sleep(0)
                        End If

                End Select
            Next

            pic = Nothing
            xlSheet = Nothing
            xlSheets = Nothing
            xlBook = Nothing
            xlBooks = Nothing
            xlApp.Quit()
            xlApp = Nothing


            GC.Collect()
            MsgBox("共儲存 " & j & " 張圖形")
        End Sub

     

    我加入的參考是 excel9 和 office9 object library

    另外想請問 Threading.Thread.Sleep(0) 這段的用意是?

    2007年3月29日 上午 08:45
  • Hi, 璉大有把釋放CPU資源相關資料整理在這邊

    http://tlcheng.spaces.live.com/blog/cns!145419920BFD55A7!1640.entry

    2007年3月29日 下午 12:04
    版主
  • 恩 我看到了,我只是覺得奇怪為何傳入0

    照鏈大文章所說的,sleep必須超過0秒才能真正釋放cpu資源

     

    還是不了解為什麼上面那段程式

    無法儲存excel中的圖形

    該不會是要excel 11.0 以上的object library 才能work吧

    2007年3月29日 下午 01:57
  • 基本上 Office 的剪貼簿都是延後提出,若是送到剪貼簿的格式沒有標準格式,則必須用更複雜的方式處理。Word 會填入 System.Drawing.Bitmap ,但是 Excel 只有部分圖檔會填入,部份不會。

     

    什麼意思嗎?先看看線上手冊關於 My.Computer.Clipboard 物件成員 的描述:

    ContainsImage  判斷剪貼簿是否包含影像。這個方法只適用於伺服器應用程式

     

    延後提出是不先把資料往剪貼簿送,而是告訴剪貼簿說,軟體提供哪些格式,等到剪貼簿收到貼上時,再把需求轉給軟體,這時軟體才把指定格式的資料送給剪貼簿,所以這類軟體就是屬於上面寫的伺服器應用程式

     

    若要抓到所有圖檔,你必須用 System.Windows.Forms.Clipboard.GetDataObject.GetFormats 取得格式,例如說不提供 System.Drawing.Bitmap 的圖檔,可能格式是:

    Code Snippet

    '(0): "Office Drawing Shape Format"

    '(1): "EnhancedMetafile"

    '(2): "MetaFilePict"

    '(3): "PNG+Office Art"

    '(4): "JFIF+Office Art"

    '(5): "GIF+Office Art"

    '(6): "PNG"

    '(7): "JFIF"

    '(8): "GIF"

    '(9): "ActiveClipBoard"

     

    再用:

    Dim ms As MemoryStream = System.Windows.Forms.Clipboard.GetDataObject.GetData("PNG", True)

    取回資料流,再用:

    Dim picImage As System.Drawing.Image = System.Drawing.Image.FromStream(ms)

     

    這部份比較複雜,那個簡單的範例不能完整包含。我自己是做個 ClipboardEx 類別來處理。 

    2007年3月30日 上午 03:39
    版主
  • 補充:

    提供 System.Drawing.Bitmap 格式的圖檔,會直接傳回 System.Drawing.Bitmap 物件,就不能透過 MemoryStream 來轉換。

    2007年3月30日 上午 03:42
    版主
  • 恩 可以抓到圖檔了 謝謝

    不果我對於這段程式不太懂
      System.Windows.Forms.Clipboard.GetDataObject.GetFormats

    因為這會傳回陣列,在我測試的程式中會傳回所有圖檔類型的字串陣列,共九種

    如果我把陣列元素0~2 傳入 GetDataObject.GetData 都不型, 3~8 就可以

    後來乾脆直接傳入 "PNG" 就好

     

    2007年4月6日 下午 01:25
  • 嗯~

    不見得每種圖形都會提供 PNG 格式,例如有提供 System.Drawing.Bitmap 格式的情況,是傳回:


    Code Snippet
     '(0): "EnhancedMetafile"
     '(1): "MetaFilePict"
     '(2): "System.Drawing.Bitmap"
     '(3): "Bitmap"
     '(4): "Biff8"
     '(5): "Biff5"
     '(6): "Biff4"
     '(7): "Biff3"
     '(8): "Biff"
     '(9): "SymbolicLink"
     '(10): "Wk1"
     '(11): "DataInterchangeFormat"
     '(12): "XML Spreadsheet"
     '(13): "HTML Format"
     '(14): "System.String"
     '(15): "UnicodeText"
     '(16): "Text"
     '(17): "Csv"
     '(18): "Hyperlink"
     '(19): "Rich Text Format"
     '(20): "Embed Source"
     '(21): "Object Descriptor"
     '(22): "Link Source"
     '(23): "Link Source Descriptor"
     '(24): "Link"
     '(25): "Format129"

     

    這種情況下用 "PNG" 是抓不到圖檔的。

     

    我自己是宣告一個陣列,當要抓點陣檔時,看看哪種格式存在:

    Private Shared m_BitmapFormat As String() = New String() {"Bitmap", "PNG", "GIF", "JPEG", "JPG", "JFIF", "System.Drawing.Bitmap"}

    2007年4月6日 下午 04:25
    版主
  • 您好!
    我參考您的範例程式,改寫並加入上面幾段程式碼測試程式。

    Imports System.IO
    Public Class Form1
        Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
            Dim i As Integer
            Dim wdApp As Object = CreateObject("Word.Application")
            Dim wdDoc As Object = wdApp.Documents.Open("c:\test.doc")
            Dim wdPic As System.Drawing.Image
            Dim nPic, iPic As Integer
            Dim strPictureName As String
            iPic = 0
            With wdDoc
                nPic = .InlineShapes.Count + .Shapes.Count
                With .InlineShapes
                    For i = 1 To .Count
                        Try
                            .Item(i).Select()
                            wdApp.Selection.Copy()
                            If My.Computer.Clipboard.ContainsImage() Then
                                iPic += 1
                                strPictureName = "c:\wdpic" & iPic.ToString("00000") & ".png"
                                wdPic = My.Computer.Clipboard.GetImage()
                                wdPic.Save(strPictureName, System.Drawing.Imaging.ImageFormat.Png)
                                Threading.Thread.Sleep(0)
                            End If
                        Catch
                        End Try
                    Next
                End With
                With .Shapes
                    For i = 1 To .Count
                        Try
                            .Item(i).Select()
                            wdApp.Selection.Copy()
                            System.Windows.Forms.Clipboard.GetDataObject.GetFormats()
                            Dim ms As MemoryStream = System.Windows.Forms.Clipboard.GetDataObject.GetData("PNG", True)
                            Dim picImage As System.Drawing.Image = System.Drawing.Image.FromStream(ms)
                            If My.Computer.Clipboard.ContainsImage() Then
                                iPic += 1
                                strPictureName = "c:\wdpic" & iPic.ToString("00000") & ".png"
                                picImage = My.Computer.Clipboard.GetImage()
                                picImage.Save(strPictureName, System.Drawing.Imaging.ImageFormat.Png)
                                Threading.Thread.Sleep(0)
                            End If
                        Catch
                        End Try
                    Next
                End With
                My.Computer.Clipboard.Clear()
                .Close()
            End With
            wdDoc = Nothing
            wdApp.Quit()
            wdApp = Nothing
            GC.Collect()
        End Sub
    End Class

    我遇到的問題是在InlineShapes裡面的圖有辦法抓出來存,但是Shapes裡面的圖一個都沒有辦法抓出來存,不知道是不是我把你給的System.Windows.Forms.Clipboard.GetDataObject.GetFormats
    Dim ms As MemoryStream = System.Windows.Forms.Clipboard.GetDataObject.GetData("PNG", True)
    Dim picImage As System.Drawing.Image = System.Drawing.Image.FromStream(ms)
    這三段程式碼放錯位置還是使用不正確呢???

    2009年5月31日 下午 05:34
  • 不是只加兩三行就可以,我自己是抽出來寫一個自定的剪貼簿類別 (ClipboardEx) 處理,整個剪貼簿類別 321 行,包含 API 的宣告,要各種狀況都能支援的話,要呼叫 API ,只抓 png 的話忘了,因為這個東西寫好成自建類別後我丟很久了,當初測試的情形沒有記錄下來,有些簡單的格式可以直接處理,我當時考慮盡量支援各種格式 (如註解行那堆),後來就乾脆改用 API 來達成一般化。這部分支援延後提出的程式碼片斷剪貼如下:

    Private Function ClipboardImageSave(ByVal strPictureName As String, ByVal strFileType As String, ByVal bEmfFirst As Boolean) As String

         Dim imgPic As Drawing.Image

         Dim imgFlags As Integer = 0

         If bEmfFirst AndAlso ClipboardEx.ContainsImage(ClipboardEx.ClipboardImageFormat.MetaFile) Then

              Dim emfBytes As Byte() = ClipboardEx.GetBytes(DataFormats.EnhancedMetafile)

              If GetEnhancedMetaFileRecordCount(emfBytes) > 20 Then

                   imgFlags = ClipboardEx.ClipboardImageFormat.MetaFile

                   strFileType = "emf"

              Else

                   imgFlags = ClipboardEx.ClipboardImageFormat.Bitmap

              End If

         ElseIf ClipboardEx.ContainsImage(ClipboardEx.ClipboardImageFormat.Bitmap) Then

              imgFlags = ClipboardEx.ClipboardImageFormat.Bitmap

         End If

     

         If imgFlags > 0 Then

              Select Case strFileType

                   Case "emf", "emz", "wmf", "wmz"

                        Dim arrBytes As Byte()

                        Dim imgFormat As DataFormats.Format

                        Select Case strFileType

                             Case "emf", "emz"

                                  imgFormat = DataFormats.GetFormat("EnhancedMetafile")

                             Case "wmf", "wmz"

                                  imgFormat = DataFormats.GetFormat("MetaFilePict")

                        End Select

     

                        arrBytes = ClipboardEx.GetBytes(imgFormat.Name)

                        imgPic = System.Drawing.Image.FromStream(New IO.MemoryStream(arrBytes))

     

                        Select Case strFileType

                             Case "emz", "wmz"

                                  arrBytes = MyGZipCompressBytes(arrBytes)

                        End Select

     

                        strPictureName &= "." & strFileType

                        MySaveBinaryFile(arrBytes, strPictureName)

                   Case Else

                        Dim imgFormat As System.Drawing.Imaging.ImageFormat = GetImageFormat(strFileType)

                        strPictureName &= "." & strFileType

                        imgPic = ClipboardEx.GetImage(imgFlags)

                        imgPic.Save(strPictureName, imgFormat)

              End Select

              wdPicBox.Image = imgPic

              wdPicBox.Refresh()

              Threading.Thread.Sleep(1)

              Return strPictureName

         Else

              Return ""

         End If

    End Function

     

    With .Shapes

         For i = 1 To .Count

              Try

                   Select Case .Item(i).Type

                        Case -2, 1, 2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13, 15, 20, 21, 22, 24

                             'msoShapeTypeMixed -2 混合圖案類型

                             'msoAutoShape 1 快取圖案。

                             'msoCallout 2 圖說文字。

                             'msoChart 3 圖表。

                             'msoComment 4 註解。

                             'msoFreeform 5 手繪多邊形。

                             'msoGroup 6 群組。

                             'msoEmbeddedOLEObject 7 內嵌的OLE 物件。

                             'msoFormControl 8 表單控制項。

                             'msoLine 9 折線圖

                             'msoLinkedOLEObject 10 連結OLE 物件

                             'msoLinkedPicture 11 連結的圖片

                             'msoOLEControlObject 12 OLE 控制項物件

                             'msoPicture 13 圖片

                             'msoPlaceholder 14 預留位置

                             'msoTextEffect 15 文字效果

                             'msoMedia 16 媒體

                             'msoTextBox 17 文字方塊

                             'msoScriptAnchor 18 指令碼錨點

                             'msoTable 19 表格

                             'msoCanvas 20 畫布。

                             'msoDiagram 21 資料庫圖表。

                             'msoInk 22 筆跡

                             'msoInkComment 23 筆跡註解

                             'msoIgxGraphic 24 IGX 圖形

     

                             .Item(i).Select()

                             wdApp.Selection.Copy()

     

                             iPic += 1

                             strPictureName = ClipboardImageSave(outPath & "\wdpic" & iPic.ToString("00000"), strFileType, bFirstEmf)

                             If strPictureName.Length > 0 Then

                                  Me.Status = "[" & iPic & "/" & nPic & "] 儲存" & strPictureName

                             Else

                                  iPic -= 1

                             End If

     

                   End Select

              Catch

                   Me.Status = "Shapes.Item(" & i & ") 傳回物件無法辨識。"

              End Try

         Next

    End With


    T.L. Cheng
    2009年6月1日 上午 04:06
    版主
  • 先謝謝您^^
    我看了很久,所以需要做到所有圖都能抓到一定要自定剪貼簿類別,
    沒辦法用簡單的方式直接修改原圖的格式然後用My.Computer.Clipboard.ContainsImage()去判斷。
    因為這好像是好久以前的東西,所以您的剪貼簿類別丟很久了,不知道有沒有辦法找到,沒辦法找到的話能不能教我方法^^
    2009年6月1日 下午 03:43
  • 東西還在,只是後來這段程式碼是有業主的,不像前面這邊的這串是我自己寫給朋友用的,所以著作人發表 (著作人格權) 的部份不能侵害到業主著作財產權的權益。

    ClipboardEx.GetImage 這段貼出來小於 1/10 ,應該還沒超出合理引用...

    Public Shared Function GetImage(Optional ByVal ClipboardFormat As ClipboardImageFormat = ClipboardImageFormat.All) As System.Drawing.Image

         Dim ido As System.Windows.Forms.IDataObject = System.Windows.Forms.Clipboard.GetDataObject

         Dim ms As IO.MemoryStream

         Dim strFmt As String = ""

     

         If ClipboardFormat And ClipboardImageFormat.Bitmap Then strFmt = GetExistFormatName(m_BitmapFormat)

         If (ClipboardFormat And ClipboardImageFormat.MetaFile) AndAlso strFmt.Length = 0 Then strFmt = GetExistFormatName(m_MetaFileFormat)

         If InStr(LCase(strFmt), "bitmap") Then

              Return ido.GetData(strFmt, True)

         Else

              ms = ido.GetData(strFmt, True)

              Return System.Drawing.Image.FromStream(ms)

         End If

    End Function

     

    我說忘了是指細節。因為後來有需要開發自定剪貼簿,我就拿這串程式碼來測,把裡面的東西通通整理進去,整理好了,原先的註解就不需要了,改用新的註解說明參數,所以細部的邏輯就不知道了。


    T.L. Cheng
    2009年6月1日 下午 03:49
    版主