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

[hematinsite]

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:

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

[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

 

[fadee2]

hi hematinsite,
your file was not found therefore can not try the code below.
maybe try it, on a copy of your excel file.

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