vba little change in code (entire workbook replace with one sheet in code)

hematinsite

New Member
Joined
Nov 3, 2020
Messages
14
Office Version
  1. 2019
Platform
  1. Windows
hi dears
i have this 2 macro for excel to jpg convert and work perfectly , but my workbook have 10 sheets and i must repeat this code for every sheets . i need change these codes
macro a :
1-for do it for entire workbook automativally and with no question
2-every export jpg file name is same as sheet name in my excel file path
3- this macro need select range before run it . i need automatically printarea by default selected for each sheets , for to convert in jpg .

macro a:

VBA Code:
Sub ExportRangeToJPG()
 '--exports selected range to jpg file
 '  default filename is address of selected range
 '  based on code example posted at:
 '     http://www.emoticode.net/visual-basic/vba-export-excel-range-as-image-and-save-as-file.html

 Dim vFilePath As Variant
 Dim sDefaultName As String
 
 If TypeName(Selection) <> "Range" Then
   MsgBox "Selection is not a range of cells."
   Exit Sub
 End If

 With Selection
   sDefaultName = Replace(.Address(0, 0, xlA1, 1), ":", "to") & ".jpg"
   vFilePath = Application.GetSaveAsFilename( _
    InitialFileName:=sDefaultName, _
    FileFilter:="JPEG File Interchange Format (*.jpg), *.jpg", _
    Title:="Save As")
    
 '--exit if cancelled by user,
 If vFilePath = False Then Exit Sub
   '--Make picture of selection and copy to clipboard
   .CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   
   '--Create an empty chart with exact size of range copied
   With ActiveSheet.ChartObjects.Add( _
        Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
     .Name = "TempChart"
     .Activate
   End With
 End With

 '--Paste into chart area, export to file, delete chart.
 ActiveChart.Paste
 With ActiveSheet.ChartObjects("TempChart")
  .Chart.Export CStr(vFilePath)
  .Delete
 End With
End Sub

and macro b :
and the next macro is for adjust zoom total sheets automatically . i need this macro , merge in with above macro a . and in first , this macro b run and then above macro a.

macro b

VBA Code:
[CODE]Sub SetZoom()

Dim ws As Worksheet
Application.ScreenUpdating = False    'Optional
For Each ws In ActiveWorkbook.Worksheets
    ws.Activate
    ActiveWindow.Zoom = 200
Next
Application.ScreenUpdating = True

End Sub
[/CODE]
and in the end , i attached example xlsm file for try on it on google drive .
main.xlsm
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

fadee2

Active Member
Joined
Nov 7, 2020
Messages
254
Office Version
  1. 2019
Platform
  1. Windows
hi hematinsite,
your file was not found therefore can not try the code below.
maybe try it, on a copy of your excel file.

VBA Code:
Sub ExportRangeToJPG()
 '--exports selected range to jpg file
 '  default filename is address of selected range
 '  based on code example posted at:
 '     http://www.emoticode.net/visual-basic/vba-export-excel-range-as-image-and-save-as-file.html
dim was as worksheet
for each ws in worksheets
 Dim vFilePath As Variant
 Dim sDefaultName As String
 
 If TypeName(Selection) <> "Range" Then
   MsgBox "Selection is not a range of cells."
   Exit Sub
 End If

 With Selection
   sDefaultName = Replace(.Address(0, 0, xlA1, 1), ":", "to") & ".jpg"
   vFilePath = Application.GetSaveAsFilename( _
    InitialFileName:=sDefaultName, _
    FileFilter:="JPEG File Interchange Format (*.jpg), *.jpg", _
    Title:="Save As")
    
 '--exit if cancelled by user,
 If vFilePath = False Then Exit Sub
   '--Make picture of selection and copy to clipboard
   .CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   
   '--Create an empty chart with exact size of range copied
   With ws.ChartObjects.Add( _
        Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
     .Name = "TempChart"
     .Activate
   End With
 End With

 '--Paste into chart area, export to file, delete chart.
 ws.Paste
 With ws.ChartObjects("TempChart")
  .Chart.Export CStr(vFilePath)
  .Delete
 End With
    ws.Activate
    ActiveWindow.Zoom = 200
Next ws

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,118,773
Messages
5,574,155
Members
412,574
Latest member
shadowfighter666
Top