Save Range as JPG

JaysonHughes

New Member
Joined
Jul 13, 2022
Messages
23
Office Version
  1. 2021
Platform
  1. Windows
This Question as been answered before but I'm unable to file a Code that works.

Sheet 15 = TOT Explanation Sheet

I need to Export A1:K33 with file name A2.JPG

On the Page is Just Text and 1 Pivot table.

I have this but the issue it that it is converting the Pivot table to image as well but this is not needed. :
Sub Export1()

Dim oWs As Worksheet
Dim oRng As Range
Dim oChrtO As ChartObject
Dim lWidth As Long, lHeight As Long

Set oWs = ActiveSheet
Set oRng = oWs.Range("A1:K33")

oRng.CopyPicture xlScreen, xlPicture
lWidth = oRng.Width
lHeight = oRng.Height

Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)

oChrtO.Activate
With oChrtO.Chart
.Paste
oChrtO.Delete
.Export Filename:="\\ant\dept-eu\NCL1\Inbound\Chronos\Export1.jpg", Filtername:="JPG"
End With



End Sub

1660470239539.png
 

Attachments

  • Screenshot 2022-08-14 105217.jpg
    Screenshot 2022-08-14 105217.jpg
    197.8 KB · Views: 13

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
I'm sorry, but I don't understand the problem - the code copies from Range A1 to K33. If the pivot table falls within that region , it stands to reason that it will also be captured by the code. If you don't want it to capture the pivot table, you would just need to provide an alternative range address, no?

I feel like I'm missing something obvious here, so my apologies in advance.
 
Upvote 0
Hey Dan Thanks for the responce, I wish to capture the pivot table but I do not wish to capture the graph. The gaph is only visable when running the code
 
Upvote 0
Ahh ok - I follow you now. Give me one second. Your code is missing a key line in it (that you normally find in this method) that deletes the generated chart image first. I'll find it for you.
 
Upvote 0
Sorry - had to restart my computer.
I just tried the following code, and it seems to work for me, but let me know how it goes for you - yo will need to adjust the range and the filename again:


VBA Code:
Sub ExportRangeToJPG()
    
    Dim oWs As Worksheet
    Dim oRng As Range
    Dim oChrtO As ChartObject
    Dim lWidth As Long, lHeight As Long
    
    Set oWs = ActiveSheet
    Set oRng = oWs.Range("A1:F30")
    
    oRng.CopyPicture xlScreen, xlPicture
    lWidth = oRng.Width
    lHeight = oRng.height
    
    Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, height:=lHeight)
    
    With oChrtO.Chart
        .ChartArea.ClearContents
        .ChartArea.Select
        .Paste
        .Export Filename:="D:\TestExport.jpg", Filtername:="JPG"
    End With
    
    oChrtO.Delete

End Sub
 
Upvote 0
One of the many reasons I fundamentally dislike the Chart method in your code. I tried it again on my system - and this time ran it on a loop over every worksheet in 4 open workbooks - and it worked (60 times?!?). I'm wondering if there is something on that worksheet (maybe an undeleted hidden chart object) interfering with it somehow?

I swapped two lines of code in the following, so it's almost exactly the same as above, just the order of events is slightly different: this time, first we select the chart area then we delete the chart area. Out of curiosity - what version of Excel are you using?

VBA Code:
Sub ExportRangeToJPG()
   
    Dim oWs As Worksheet
    Dim oRng As Range
    Dim oChrtO As ChartObject
    Dim lWidth As Long, lHeight As Long
   
    Set oWs = ActiveSheet
    Set oRng = oWs.Range("D10:F30")
   
    oRng.CopyPicture xlScreen, xlPicture
    lWidth = oRng.Width
    lHeight = oRng.height
   
    Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, height:=lHeight)
   
    With oChrtO.Chart
        .ChartArea.Select
        .ChartArea.ClearContents
        .Paste
        .Export Filename:="D:\TestExport.jpg", Filtername:="JPG"
    End With
   
    oChrtO.Delete

End Sub
 
Upvote 0
Thanks for that went down the Screen shot option worked with very minimal changes to code :)
 
Upvote 0

Forum statistics

Threads
1,215,106
Messages
6,123,122
Members
449,096
Latest member
provoking

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top