Export pictures from excel file into jpg using VBA

Question

I have an Excel file which includes pictures in column B and I want like to export them into several files as  jpg  or any other picture file format   The name of the file should be generated from text in column A  I tried following VBA macro    Private Sub CommandButton1 Click   Dim oTxt As Object  For Each cell In Ark1 Range  A1 A   amp  Ark1 UsedRange Rows Count     you can change the sheet1 to your own choice  saveText   cell Text  Open  H  Webshop Zpider Strukturbildene    amp  saveText  amp    jpg  For Output As  1  Print  1  cell Offset 0  1  text  Close  1  Next cell End Sub   The result is that it generates files  jpg   without any content  I assume the line Print  1  cell Offset 0  1  text  is wrong  I don t know what I need to change it into  cell Offset 0  1  pix   Can anybody help me  Thanks

User · Answer

Thanks for the ideas  I used the above ideas to make a macro to do a bulk file conversion--convert every file of one format in a folder to another format   This code requires a sheet with cells named  FilePath   which must end in a        StartExt   original file extension   and  EndExt   desired file extension   Warning  it doesn t ask for confirmation before replacing existing files with the same name and extension   Private Sub CommandButton1 Click       Dim path As String     Dim pathExt As String     Dim file As String     Dim oldExt As String     Dim newExt As String     Dim newFile As String     Dim shp As Picture     Dim chrt As ChartObject     Dim chrtArea As Chart      Application ScreenUpdating   False     Application DisplayAlerts   False       Get settings entered by user     path   Range  FilePath       oldExt   Range  StartExt       pathExt   path  amp        amp  oldExt     newExt   Range  EndExt        file   Dir pathExt       Do While Not file       cycle through all images in folder of selected format         Set shp   ActiveSheet Pictures Insert path  amp  file   Import image         newFile   Replace file       amp  oldExt       amp  newExt   Determine new file name         Set chrt   ActiveSheet ChartObjects Add 0  0  shp Width  shp Height   Create blank chart for embedding image         Set chrtArea   chrt Chart         shp CopyPicture  Copy image to clipboard         With chrtArea  Paste image to chart  then export              ChartArea Select              Paste              Export  path  amp  newFile          End With         chrt Delete  Delete chart         shp Delete  Delete imported image          file   Dir  Advance to next file     Loop      Application ScreenUpdating   True     Application DisplayAlerts   True   End Sub

User · Answer

If i remember correctly  you need to use the  Shapes  property of your sheet   Each Shape object has a TopLeftCell and BottomRightCell attributes that tell you the position of the image   Here s a piece of code i used a while ago  roughly adapted to your needs  I don t remember the specifics about all those ChartObjects and whatnot  but here it is   For Each oShape In ActiveSheet Shapes     strImageName   ActiveSheet Cells oShape TopLeftCell Row  1  Value     oShape Select      Picture format initialization     Selection ShapeRange PictureFormat Contrast   0 5  Selection ShapeRange PictureFormat Brightness   0 5  Selection ShapeRange PictureFormat ColorType   msoPictureAutomatic  Selection ShapeRange PictureFormat TransparentBackground   msoFalse  Selection ShapeRange Fill Visible   msoFalse  Selection ShapeRange Line Visible   msoFalse  Selection ShapeRange Rotation   0   Selection ShapeRange PictureFormat CropLeft   0   Selection ShapeRange PictureFormat CropRight   0   Selection ShapeRange PictureFormat CropTop   0   Selection ShapeRange PictureFormat CropBottom   0   Selection ShapeRange ScaleHeight 1   msoTrue  msoScaleFromTopLeft  Selection ShapeRange ScaleWidth 1   msoTrue  msoScaleFromTopLeft       Picture format initialization     Application Selection CopyPicture     Set oDia   ActiveSheet ChartObjects Add 0  0  oShape Width  oShape Height      Set oChartArea   oDia Chart     oDia Activate     With oChartArea          ChartArea Select          Paste          Export   H  Webshop Zpider Strukturbildene    amp  strImageName  amp    jpg       End With     oDia Delete  oChartArea Delete Next

User · Answer

Here is another cool way to do it- using en external viewer that accepts command line switches  IrfanView in this case      I based the loop on what Michal Krzych has written above   Sub ExportPicturesToFiles       Const saveSceenshotTo As String    C  temp       Const pictureFormat As String     jpg       Dim pic As Shape     Dim sFileName As String     Dim i As Long      i   1      For Each pic In ActiveSheet Shapes         pic Copy         sFileName   saveSceenshotTo  amp  Range  A   amp  i  Text  amp  pictureFormat          Call ExportPicWithIfran sFileName           i   i   1     Next End Sub  Public Sub ExportPicWithIfran sSaveAsPath As String      Const sIfranPath As String    C  Program Files IrfanView i view32 exe      Dim sRunIfran As String      sRunIfran   sIfranPath  amp     clippaste  convert    amp                                sSaveAsPath  amp     killmesoftly         Shell is no good here  If you have more than 1 pic  it will       mess things up  pics will over run other pics  becuase Shell does       not make vba wait for the script to finish         Shell sRunIfran  vbHide        Correct way  it will now wait for the batch to finish       call MyShell sRunIfran   End Sub   Edit        Private Sub MyShell strShell As String      based on        http   stackoverflow com questions 15951837 excel-vba-wait-for-shell-command-to-complete      by Nate Hekman      Dim wsh As Object     Dim waitOnReturn As Boolean      Dim windowStyle As VbAppWinStyle      Set wsh   VBA CreateObject  WScript Shell       waitOnReturn   True     windowStyle   vbHide      wsh Run strShell  windowStyle  waitOnReturn End Sub

User · Answer

This code   Option Explicit  Sub ExportMyPicture         Dim MyChart As String  MyPicture As String      Dim PicWidth As Long  PicHeight As Long       Application ScreenUpdating   False      On Error GoTo Finish       MyPicture   Selection Name      With Selection            PicHeight    ShapeRange Height            PicWidth    ShapeRange Width      End With       Charts Add      ActiveChart Location Where  xlLocationAsObject  Name   Sheet1       Selection Border LineStyle   0      MyChart   Selection Name  amp       amp  Split ActiveChart Name       2        With ActiveSheet            With  Shapes MyChart                    Width   PicWidth                   Height   PicHeight            End With              Shapes MyPicture  Copy             With ActiveChart                   ChartArea Select                   Paste            End With              ChartObjects 1  Chart Export Filename   MyPic jpg   FilterName   jpg              Shapes MyChart  Cut      End With       Application ScreenUpdating   True      Exit Sub  Finish       MsgBox  You must select a picture  End Sub   was copied directly from here  and works beautifully for the cases I tested

User · Answer

New versions of excel have made old answers obsolete  It took a long time to make this  but it does a pretty good job  Note that the maximum image size is limited and the aspect ratio is ever so slightly off  as I was not able to perfectly optimize the reshaping math  Note that I ve named one of my worksheets wsTMP  you can replace it with Sheet1 or the like  Takes about 1 second to print the screenshot to target path   Option Explicit  Private Declare PtrSafe Sub keybd event Lib  user32   ByVal bVk As Byte  ByVal bScan As Byte  ByVal dwFlags As Long  ByVal dwExtraInfo As Long   Sub weGucciFam    Dim tmp As Variant  str As String  h As Double  w As Double  Application PrintCommunication   False Application EnableEvents   False Application Calculation   xlCalculationManual Application ScreenUpdating   False If Application StatusBar   False Then Application StatusBar    EVENTS DISABLED   keybd event vbKeyMenu  0  0  0  these do just active window keybd event vbKeySnapshot  0  0  0 keybd event vbKeySnapshot  0  2  0 keybd event vbKeyMenu  0  2  0  sendkeys alt printscreen doesn t work wsTMP Paste DoEvents Const dw As Double   1186 56 Const dh As Double   755 28  str    C  Users YOURUSERNAMEHERE Desktop Screenshot jpeg  w   wsTMP Shapes 1  Width h   wsTMP Shapes 1  Height  Application DisplayAlerts   False Set tmp   Charts Add On Error Resume Next With tmp      PageSetup PaperSize   xlPaper11x17      PageSetup TopMargin   IIf w  gt  dw  dh - dw   h   w  dh - h    28      PageSetup BottomMargin   0      PageSetup RightMargin   IIf h  gt  dh  dw - dh   w   h  dw - w    36      PageSetup LeftMargin   0      PageSetup HeaderMargin   0      PageSetup FooterMargin   0      SeriesCollection 1  Delete     DoEvents      Paste     DoEvents      Export Filename  str  Filtername   jpeg       Delete End With On Error GoTo 0 Do Until wsTMP Shapes Count  lt  1     wsTMP Shapes 1  Delete Loop  Application PrintCommunication   True Application EnableEvents   True Application Calculation   xlCalculationAutomatic Application ScreenUpdating   True Application StatusBar   False  End Sub

User · Answer

Dim filepath as string Sheets  Sheet 1   ChartObjects  Chart 1   Chart Export filepath  amp   Name jpg    Slimmed down the code to the absolute minimum if needed

User · Answer

Set Range you want to export to the folder  Workbooks  your workbook name   Sheets  yoursheet name   Select  Dim rgExp As Range  Set rgExp   Range  A1 H31       Copy range as picture onto Clipboard rgExp CopyPicture Appearance  xlScreen  Format  xlBitmap     Create an empty chart with exact size of range copied With ActiveSheet ChartObjects Add Left  rgExp Left  Top  rgExp Top    Width  rgExp Width  Height  rgExp Height   Name    ChartVolumeMetricsDevEXPORT   Activate End With     Paste into chart area  export to file  delete chart  ActiveChart Paste ActiveSheet ChartObjects  ChartVolumeMetricsDevEXPORT   Chart Export  C  ExportmyChart jpg  ActiveSheet ChartObjects  ChartVolumeMetricsDevEXPORT   Delete

[image] Export pictures from excel file into jpg using VBA

Examples related to image

Examples related to excel

Examples related to vba

Examples related to export