Error in a macro to save the active sheet in a .png file

mad4max

New Member
Joined
Mar 30, 2014
Messages
18
Hi guys...

I have a little problem... I have the weekly menu of a restaurant that I try to save in a .png file as I need to publish it on our website... But, when I run the macro, it stops on:

ActiveSheet.CopyPicture Format:=xlPicture

Here is the full macro:

Sub SaveAsPNG()
Dim FileLocation As String
Dim FileName As String
Dim SheetName As String
Dim FilePath As String
Dim ParamSheet As Worksheet

' Set a reference to the "param" worksheet
Set ParamSheet = ThisWorkbook.Worksheets("param")

' Get the directory location from cell E14 of the "param" worksheet
FileLocation = ParamSheet.Range("E14").Value

' Get the filename from cell E15 of the "param" worksheet
FileName = ParamSheet.Range("E15").Value

' Get the active sheet's name
SheetName = ActiveSheet.Name

' Define the file path and name based on the location and filename
FilePath = FileLocation & "\" & FileName & ".png"

' Export the active sheet as a .png file
ActiveSheet.CopyPicture Format:=xlPicture
With ActiveSheet.Shapes.AddPicture(FilePath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=1, Height:=1)
.LockAspectRatio = msoTrue
.Width = ActiveSheet.UsedRange.Width
.Height = ActiveSheet.UsedRange.Height
End With
ActiveSheet.Shapes(SheetName).Delete

End Sub

Knowing that:
  • I have a sheet called PARAM
  • In sheet PARAM, the destination folder is located in the cell E14
  • In sheet PARAM the filename is located in the cell E15
see the image:

ParamImage.png


I use this way, as the filename is composed by several params located in another sheet...

If anybody has a better idea on how to write or correct this macro, you're welcome!

Thank you for your always valuable help...
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Try this:

VBA Code:
Sub SaveAsPNG()
  Dim FileLocation As String
  Dim FileName As String
  Dim SheetName As String
  Dim FilePath As String
  Dim ParamSheet As Worksheet
  Dim rng As Range
  
  ' Set a reference to the "param" worksheet
  Set ParamSheet = ThisWorkbook.Worksheets("param")
  
  ' Get the directory location from cell E14 of the "param" worksheet
  FileLocation = ParamSheet.Range("E14").Value
  
  ' Get the filename from cell E15 of the "param" worksheet
  FileName = ParamSheet.Range("E15").Value
  
  ' Get the active sheet's name
  SheetName = ActiveSheet.Name
  
  ' Define the file path and name based on the location and filename
  FilePath = FileLocation & "\" & FileName & ".png"
  
  ' Export the active sheet as a .png file
  Set rng = ActiveSheet.Range("A1:F10")
  rng.CopyPicture Format:=xlPicture
  
  With ActiveSheet.ChartObjects.Add(rng.Left, rng.Top, rng.Width, rng.Height)
    .Name = "tmppng"
      .Activate
      .Chart.Paste
      .Chart.Export FilePath, "PNG"
  End With
  
  On Error Resume Next
  ActiveSheet.Shapes("tmppng").Delete
  On Error GoTo 0
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------
 
Upvote 0
Try this:

VBA Code:
Sub SaveAsPNG()
  Dim FileLocation As String
  Dim FileName As String
  Dim SheetName As String
  Dim FilePath As String
  Dim ParamSheet As Worksheet
  Dim rng As Range
 
  ' Set a reference to the "param" worksheet
  Set ParamSheet = ThisWorkbook.Worksheets("param")
 
  ' Get the directory location from cell E14 of the "param" worksheet
  FileLocation = ParamSheet.Range("E14").Value
 
  ' Get the filename from cell E15 of the "param" worksheet
  FileName = ParamSheet.Range("E15").Value
 
  ' Get the active sheet's name
  SheetName = ActiveSheet.Name
 
  ' Define the file path and name based on the location and filename
  FilePath = FileLocation & "\" & FileName & ".png"
 
  ' Export the active sheet as a .png file
  Set rng = ActiveSheet.Range("A1:F10")
  rng.CopyPicture Format:=xlPicture
 
  With ActiveSheet.ChartObjects.Add(rng.Left, rng.Top, rng.Width, rng.Height)
    .Name = "tmppng"
      .Activate
      .Chart.Paste
      .Chart.Export FilePath, "PNG"
  End With
 
  On Error Resume Next
  ActiveSheet.Shapes("tmppng").Delete
  On Error GoTo 0
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------
Hello.... Thank you for your help, but unfortunately, it doesn't help...
It blocks on this:

ErrorPage.png

I just corrected the cells address to match my worksheet...
File Directory is in cell E15, sheet PARAM
File Name is in cell E16, sheet PARAM
Range to export the ActiveSheet (named OFFRE) to .PNG is: A155:M58
But, I running the macro, the debug showed me it stopped on the instruction highlighted in yellow... :(
Any idea about?
Thank you...
 
Upvote 0
Check the following:

1.
But, I running the macro, the debug showed me it stopped on the instruction highlighted in yellow.
What does the error message say?

2.
File Directory is in cell E15, sheet PARAM
You must verify that the path you have in cell E15 really exists, verify that it is written correctly.

3.
1695999374026.png


If in cell E15 the path already has the diagonal at the end of the name then in the macro it should be like this:

VBA Code:
FilePath = FileLocation & FileName & ".png"


Try again.
I hope to hear from you soon.
Respectfully
Dante Amor
--------------
 
Upvote 0
When the code has halted and the offending line is highlighted in yellow, go to the Immediate Window and type this:

VBA Code:
? FilePath

and press Enter. What does it show? Does that path actually exist?

Try with a file name with a reasonable length. Does it still fail?
 
Upvote 0

Forum statistics

Threads
1,215,108
Messages
6,123,131
Members
449,097
Latest member
mlckr

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