6 Replies Latest reply: Dec 31, 2014 3:14 AM by Duo Zhou RSS

    PasteSpecial Bitmap macro

      Hi,

       

      I  am trying to paste a Clear   image of my chart to excel,

       

      I have a macro that does this but it comes out fuzzy.

       

      this is a piece of the macro:

       

      if (pasteMode = "image") then

                                              Call objSource.CopyBitmapToClipboard()

                                    else

                                              Call objSource.CopyTableToClipboard(true) '// default & fallback

                                    end if

       

                                    Set objCurrentSheet = objExcelDoc.Sheets(sheetName)

                                    objExcelDoc.Sheets(sheetName).Range(sheetRange).Select

                                    objExcelDoc.Sheets(sheetName).PasteSpecial

       

       

      Kind Regards

      Abdur Razak

        • Re: PasteSpecial Bitmap macro

          I am also trying to figure out if VBScript supports PasteSpecial in bitmap mode.

           

          If anyone knows, please let me know.

            • Re: PasteSpecial Bitmap macro

              Hi,

               

              I think this works,

               

               

              SUB SendExcel

                    set XLApp = CreateObject("Excel.Application") ' Define Object

                    XLApp.Visible = True 'Visible set as true

                    set XLDoc = XLApp.Workbooks.Add 'Open new workbook

                         

                    Set obj = ActiveDocument.GetSheetObject("CH01") 

                    obj.CopyBitmapToClipboard

                    XLDoc.Sheets(1).Range("B8").Select

                    XLDoc.Sheets(1).PasteSpecial DataType=wdPasteBitmap

              End Sub

               

               

              Kind Regards

              Dreamer

                • Re: PasteSpecial Bitmap macro
                  Wojciech Parzyszek

                  great job;)

                  I was looking for This solution

                  • Re: PasteSpecial Bitmap macro
                    Keenan Morton

                    Hi Dreamer

                     

                    The wdPasteBitmap does work. However, if you are looking to PasteSpecial to improve the quality of your image, it did not seem to make a difference for me, Not as clear as a manual Paste Special -> as Bitmap.. in Excel.

                     

                    The vb PasteSpecial using 'With' below, worked for me. I now have crystal clear images from Qlikview into Excel. Plus the resultant File Size is smaller with images pasted in this manner than what they are in the wdPasteBitmap method. Hope it helps.

                     

                    SUB SendExcel

                          set XLApp = CreateObject("Excel.Application") ' Define Object

                          XLApp.Visible = True 'Visible set as true

                          set XLDoc = XLApp.Workbooks.Add 'Open new workbook

                     

                          Set obj = ActiveDocument.GetSheetObject("CH01")

                          obj.CopyBitmapToClipboard()

                          XLDoc.Sheets(1).Range("B8").Select

                     

                           With XLDoc.Sheets(1)

                              .Range("B8").PasteSpecial _

                              Operation=xlPasteSpecialOperationAdd

                           End With

                    End Sub

                    • Re: PasteSpecial Bitmap macro

                      Great!! 'PasteSpecial DataType=wdPasteBitmap' do me a great favor. Beautiful!

                  • Re: PasteSpecial Bitmap macro
                    Keenan Morton

                    In your original statement it would look more like this:

                     

                     

                    Set objCurrentSheet = objExcelDoc.Sheets(sheetName)

                    objExcelDoc.Sheets(sheetName).Range(sheetRange).Select

                    if (pasteMode = "image") then    

                         With objExcelDoc.Sheets(sheetName) 

                              .Range(sheetRange).PasteSpecial _

                              Operation=xlPasteSpecialOperationAdd

                         End With

                    else

                         objExcelDoc.Sheets(sheetName).Paste

                    end if