Using VBA code how to export Excel worksheets as image in Excel 2003

Question

Please suggest the better way of exporting range of data from excel worksheets as image either in  jpeg or  png or in  gif

User · Answer

I ve tried to improve this solution in several ways  Now resulting image has right proportions   Set sheet   ActiveSheet output    D  SavedRange4 png   zoom coef   100   sheet Parent Windows 1  Zoom Set area   sheet Range sheet PageSetup PrintArea  area CopyPicture xlPrinter Set chartobj   sheet ChartObjects Add 0  0  area Width   zoom coef  area Height   zoom coef  chartobj Chart Paste chartobj Chart Export output   png  chartobj Delete

User · Answer

Thanks everyone  I modified Winand s code slightly to export it to the user s desktop  no matter who is using the worksheet  I gave credit in the code to where I got the idea  thanks Kyle    Sub ExportImage     Dim sFilePath As String Dim sView As String   Captures current window view sView   ActiveWindow View   Sets the current view to normal so there are no  Page X  overlays on the image ActiveWindow View   xlNormalView   Temporarily disable screen updating Application ScreenUpdating   False  Set Sheet   ActiveSheet   Set the file path to export the image to the user s desktop  I have to give credit to Kyle for this solution  found it here   http   stackoverflow com questions 17551238 vba-how-to-save-excel-workbook-to-desktop-regardless-of-user sFilePath   CreateObject  WScript Shell   specialfolders  Desktop    amp       amp  ActiveSheet Name  amp    png    Export print area as correctly scaled PNG image  courtasy of Winand zoom coef   100   Sheet Parent Windows 1  Zoom Set area   Sheet Range Sheet PageSetup PrintArea  area CopyPicture xlPrinter Set chartobj   Sheet ChartObjects Add 0  0  area Width   zoom coef  area Height   zoom coef  chartobj Chart Paste chartobj Chart Export sFilePath   png  chartobj Delete   Returns to the previous view ActiveWindow View   sView   Re-enables screen updating Application ScreenUpdating   True   Tells the user where the image was saved MsgBox   Export completed  The file can be found here    amp  Chr 10   amp  Chr 10   amp  sFilePath   End Sub

User · Answer

This gives me the most reliable results   Sub RangeToPicture     Dim FileName As String  FileName    C  file bmp    Dim rPrt As Range  Set rPrt   ThisWorkbook Sheets  Sheet1   Range  A1 C6      Dim chtObj As ChartObject   rPrt CopyPicture xlScreen  xlBitmap   Set chtObj   ActiveSheet ChartObjects Add 1  1  rPrt Width  rPrt Height    chtObj Activate   ActiveChart Paste   ActiveChart Export FileName   chtObj Delete End Sub

User · Answer

If you add a Selection and saving to workbook path to Ryan Bradley code that will be more elastic    Sub ExportImage    Dim sheet  zoom coef  area  chartobj Dim sFilePath As String Dim sView As String   Captures current window view sView   ActiveWindow View   Sets the current view to normal so there are no  Page X  overlays on the image ActiveWindow View   xlNormalView   Temporarily disable screen updating Application ScreenUpdating   False  Set sheet   ActiveSheet   Set the file path to export the image to the user s desktop  I have to give credit to Kyle for this solution  found it here   http   stackoverflow com questions 17551238 vba-how-to-save-excel-workbook-to-desktop-regardless-of-user  sFilePath   CreateObject  WScript Shell   specialfolders  Desktop    amp       amp  ActiveSheet Name  amp    png                        Lukasz   Save to  workbook directory  Asking for filename insted of ActiveSheet Name is also good idea  without file extension dim FileID as string FileID inputbox  Type a file name   Filename      ActiveSheet Name  sFilePath   ThisWorkbook Path  amp       amp  FileID  amp    png    Lukasz Change code to use Selection  Simply select what you want to export and run the macro  ActiveCell should be  Top Left   it means select from top left corner to right bottom corner  Dim r As Long  c As Integer  ar As Long  ac As Integer      r   Selection rows Count     c   Selection Columns Count     ar   ActiveCell Row     ac   ActiveCell Column     ActiveSheet PageSetup PrintArea   Range Cells ar  ac   Cells ar  ac   Resize r  c  Address   Export print area as correctly scaled PNG image  courtasy of Winand  Lukasz  zoom coef can be constant   0 to 5 can work too  but save is 0 to 4 zoom coef   5  100   sheet Parent Windows 1  Zoom                Set area   sheet Range sheet PageSetup PrintArea  area CopyPicture xlPrinter   xlBitmap   Set chartobj   sheet ChartObjects Add 0  0  area Width   zoom coef  area Height   zoom coef  chartobj Chart Paste chartobj Chart Export sFilePath   png  chartobj Delete   Returns to the previous view ActiveWindow View   sView   Re-enables screen updating Application ScreenUpdating   True   Tells the user where the image was saved MsgBox   Export completed  The file can be found here      amp  Chr 10   amp  Chr 10   amp  sFilePath   Close End Sub

User · Answer

Solution without charts  Function SelectionToPicture nome    save location   change if you want   FName   CreateObject  WScript Shell   SpecialFolders  Desktop    amp       amp  nome  amp    jpg    copy selection and get size Selection CopyPicture xlScreen  xlBitmap w   Selection Width h   Selection Height    With ThisWorkbook ActiveSheet       Activate      Dim chtObj As ChartObject     Set chtObj    ChartObjects Add 100  30  400  250      chtObj Name    TemporaryPictureChart        resize obj to picture size     chtObj Width   w     chtObj Height   h      ActiveSheet ChartObjects  TemporaryPictureChart   Activate     ActiveChart Paste      ActiveChart Export FileName  FName  FilterName   jpg       chtObj Delete  End With End Function

User · Answer

Based on the link provided by Philip I got this to working  Worksheets  Final Analysis Sheet   Range  A4 G112   CopyPicture xlScreen  xlBitmap      Application DisplayAlerts   False     Set oCht   Charts Add     With oCht          Paste          Export Filename   C  FTPDailycheck TodaysImages SavedRange jpg   Filtername   JPG           Delete     End With

User · Answer

There s a more direct way to export a range image to a file  without the need to create a temporary chart  It makes use of PowerShell to save the clipboard as a  png file  Copying the range to the clipboard as an image is straightforward  using the vba CopyPicture command  as shown in some of the other answers  A PowerShell script to save the clipboard requires only two lines  as noted by thom schumacher in Save Image from clipboard using PowerShell  VBA can launch a PowerShell script and wait for it to complete  as noted by Asam in Wait for shell command to complete  Putting these ideas together  we get the following routine  I ve tested this only under Windows 10 using the Office 2010 version of Excel  Note that there s an internal constant AidDebugging which can be set to True to provide additional feedback about the execution of the routine  Option Explicit    This routine copies the bitmap image of a range of cells to a  png file    Input arguments       RangeRef -- the range to be copied  This must be passed as a range object  not as the name                  or address of the range       Destination -- the name  including path if necessary  of the file to be created  ending in                  the extension  quot  png quot   It will be overwritten without warning if it exists       TempFile -- the name  including path if necessary  of a temporary script file which will be                  created and destroyed  If this is not supplied  file  quot RangeToPNG ps1 quot  will be                  created in the default folder  If AidDebugging is set to True  then this file                  will not be deleted  so it can be inspected for debugging    If the PowerShell script file cannot be launched  then this routine will display an error message    However  if the script can be launched but cannot create the resulting file  this script cannot   detect that  To diagnose the problem  change AidDebugging from False to True and inspect the   PowerShell output  which will remain in view until you close its window   Public Sub RangeToPNG RangeRef As Range  Destination As String                          Optional TempFile As String    quot RangeToPNG ps1 quot   Dim WSH As Object Dim PSCommand As String Dim WindowStyle As Integer Dim ErrorCode As Integer Const WaitOnReturn   True Const AidDebugging   False   provide extra feedback about this routine s execution     Create a little PowerShell script to save the clipboard as a  png file     The script is based on a version found on September 13  2020 at        https   stackoverflow com questions 55215482 save-image-from-clipboard-using-powershell    Open TempFile For Output As  1    If  AidDebugging  Then   output some extra feedback       Print  1   quot Set-PSDebug -Trace 1 quot    optional -- aids debugging    End If    Print  1   quot  img   get-clipboard -format image quot     Print  1   quot  img save  quot  quot  quot   amp  Destination  amp   quot  quot  quot   quot     If  AidDebugging  Then   leave the PowerShell execution record on the screen for review       Print  1   quot Read-Host -Prompt  quot  quot Press  lt Enter gt  to continue quot  quot   quot        WindowStyle   1   display window to aid debugging    Else       WindowStyle   0   hide window    End If    Close  1     Copy the desired range of cells to the clipboard as a bitmap image    RangeRef CopyPicture xlScreen  xlBitmap     Execute the PowerShell script    PSCommand    quot POWERSHELL exe -ExecutionPolicy Bypass -file  quot  quot  quot   amp  TempFile  amp   quot  quot  quot   quot     Set WSH   VBA CreateObject  quot WScript Shell quot      ErrorCode   WSH Run PSCommand  WindowStyle  WaitOnReturn     If  ErrorCode  lt  gt  0  Then       MsgBox  quot The attempt to run a PowerShell script to save a range  quot   amp                  quot as a  png file failed -- error code  quot   amp  ErrorCode    End If    If  Not AidDebugging  Then        Delete the script file  unless it might be useful for debugging       Kill TempFile    End If End Sub    Here s an example which tests the routine above  Sub Test      RangeToPNG Worksheets  quot Sheet1 quot   Range  quot A1 F13 quot     quot E  Temp ExportTest png quot  End Sub

User · Answer

do you want to try the below code I found on the internet somewhere many moons ago and used   It uses the Export function of the Chart object along with the CopyPicture method of the Range object   References     MSDN - Export method as it applies to the Chart object  to save the clipboard as an Image MSDN - CopyPicture method as it applies to the Range object to copy the range as a picture  dim sSheetName as string dim oRangeToCopy as range Dim oCht As Chart  sSheetName   Sheet1    worksheet to work on set  oRangeToCopy  Range  B2 H8     range to be copied  Worksheets sSheetName  Range oRangeToCopy  CopyPicture xlScreen  xlBitmap set oCht  charts add  with oCht      paste      Export FileName   C  SavedRange jpg   Filtername   JPG  end with

User · Answer

Winand  Quality was also an issue for me so I did this   For Each ws In ActiveWorkbook Worksheets     If ws PageSetup PrintArea  lt  gt     Then          Reverse the effects of page zoom on the exported image         zoom coef   100   ws Parent Windows 1  Zoom         areas   Split ws PageSetup PrintArea               areaNo   0         For Each a In areas             Set area   ws Range a                Change xlPrinter to xlScreen to see zooming white space             area CopyPicture Appearance  xlPrinter  Format  xlPicture             Set chartobj   ws ChartObjects Add 0  0  area Width   zoom coef  area Height   zoom coef              chartobj Chart Paste              scale the image before export             ws Shapes chartobj Index  ScaleHeight 3  msoFalse  msoScaleFromTopLeft             ws Shapes chartobj Index  ScaleWidth 3  msoFalse  msoScaleFromTopLeft             chartobj Chart Export ws Name  amp   -   amp  areaNo  amp    png    png              chartobj delete             areaNo   areaNo   1         Next     End If Next   See here https   robp30 wordpress com 2012 01 11 improving-the-quality-of-excel-image-export

[vba] Using VBA code, how to export Excel worksheets as image in Excel 2003?

Examples related to vba

Examples related to image

Examples related to excel

Examples related to export