I need a Christmas miracle - Saving Excel tables as pictures in a folder - Application-defined or object-defined error

[chino3589]

Hi,
I use VBA macros to take my data from an Excel spreadsheet and populate a Word document through a mailmerge. The goal of the main macro is to save multiple Excel tables in a jpg format into a specific folder.

The main macro do the following tasks:

1. Take various Excel table (with named range TABLE1, TABLE2 etc.) from multiple Excel sheets in the same Excel file and establish if the table is needed
2. Copy the Excel table and paste it as a picture over the Excel cells
3. Create a temporary chart and use the picture from step 2 to populate the chart
4. Export the Chart as a .jpg in the desired folder with the desired picture name
5. Delete the temporary chart and picture from step 2 & 3
6. Repeat for all tables

The macro usually works fine and is part of a final macro that combined other macros for the final mail merge.

THE PROBLEM

On line Sh.CopyPicture, I keep getting the error message Run-time error ‘1004’ Application-defined or object-defined error.

Everything works as expected in the macro until lines tmpChart.ChartArea.Width = Sh.Width and tmpChart.ChartArea.Height = Sh.Height do not return the expected results (the dimensions of the chart should be the same as of the picture, but in the macro they are way smaller).

I will answer all questions if you need more info.

Thank you and have a great Christmas time

Sub SelectedRangeToImage()
Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, Sh As Shape, rng As Range
Dim fileSaveName As Variant, pic As Variant
Dim strFolders As String
Dim i As Integer

strFolders = Application.ThisWorkbook.Path
strFolders = strFolders & "\" & "TablesPictures"
Shell ("cmd /c md " & Chr(34) & strFolders & Chr(34))

i = 1
Do Until i > 4    'Below are conditions to run only relevant tables


If (i = 1 And Range("Show_Table1").Value = "No") Or (i = 2 And Range("Show_Table2").Value = "No") _
Or (i = 3 And Range("Show_Table3").Value = "No") Or (i = 4 And Range("Show_Table4").Value = "No") Then
i = i + 1
   
Else

Application.Goto Reference:="TABLE" & i

ActiveWindow.Zoom = 300                        'Very important to zoom, otherwise the pictures are blurry

'Create temporary chart as canvas
Set sht = ActiveSheet
Set rng = sht.Range("Table" & i)
    rng.CopyPicture

With sht.Pictures.Paste
End With

Set Sh = sht.Shapes(sht.Shapes.Count)
Set tmpChart = Charts.Add
tmpChart.ChartArea.Clear
tmpChart.Name = "PicChart" & (Rnd() * 10000)
Set tmpChart = tmpChart.Location(Where:=xlLocationAsObject, Name:=sht.Name)
tmpChart.ChartArea.Width = Sh.Width
tmpChart.ChartArea.Height = Sh.Height
tmpChart.Parent.Border.LineStyle = 0

'Paste range as image to chart
    
Sh.CopyPicture    'HERE IS THE ERROR MESSAGE

With tmpChart.Pictures.Paste
End With

tmpChart.Export Filename:=strFolders & "\" & "Table" & i & ".jpg", Filtername:="JPG"
       
'Clean up
sht.Cells(1, 1).Activate
sht.ChartObjects(sht.ChartObjects.Count).Delete
Sh.Delete

ActiveWindow.Zoom = 115

i = i + 1
End If

Loop
End Sub

 

[NdNoviceHlp]

This might get U started. HTH. Dave

Set sht = ActiveSheet
Set rng = sht.Range("Table1")
    rng.CopyPicture
Charts.Add.Location Where:=xlLocationAsObject, Name:=sht.Name
Set CurrentChart = Sheets(sht.Name).ChartObjects(1).Chart
CurrentChart.Parent.Width = rng.Width
CurrentChart.Parent.Height = rng.Height
CurrentChart.Pictures.Paste

 

[NdNoviceHlp]

I guess I should have mentioned also that U can paste the XL table to a Word document without the chart image thing...

Set oApp = CreateObject("Word.Application")
'create doc
Set oDoc = oApp.Documents.Add
'Copy Table Range from Excel
      Set tbl = ThisWorkbook.Worksheets(1).ListObjects(1).Range
      tbl.Copy  
    'Paste Table into MS Word using inserted Bookmark
      oDoc.Bookmarks("BookmarkName").Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=False

Dave

 

[chino3589]

Thank you Dave! Not only it works great but my macro also run way faster. You have no idea how much I appreciate your answers. That was the Christmas miracle I needed!

Thank you and have a great Christmas time

 

[NdNoviceHlp]

You are welcome. Thanks for posting your miraculous outcome! Enjoy your Xmas and be safe. Dave