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:
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
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:
- 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
- Copy the Excel table and paste it as a picture over the Excel cells
- Create a temporary chart and use the picture from step 2 to populate the chart
- Export the Chart as a .jpg in the desired folder with the desired picture name
- Delete the temporary chart and picture from step 2 & 3
- Repeat for all tables
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
VBA Code:
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