I'm facing a problem (Run Time Error '1004' Copy method of picture class failed) randomly while running this VBA. Any solution to avoid this error?
VBA Code:
' print payslip for all selected employees
' uses the selected rows
Sub PrintPaySlips()
Dim rCl As Range
Dim rRng As Range
With Sheets("Project")
Set rRng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
For Each rCl In rRng
With Sheets("Payslip")
.Cells(3, 7).Value = rCl.Value
Dim xRg As Range
Application.ScreenUpdating = False
For Each xRg In Range("G12:G33")
If xRg.Value = "0" Then
xRg.EntireRow.Hidden = True
Else
xRg.EntireRow.Hidden = False
End If
Next xRg
Application.ScreenUpdating = True
Dim ChO As ChartObject, ExportName As String
Dim CopyRange As Range
Dim Pic As Picture
Dim i As Long
Dim Fold As String
Dim Name As String
Dim Path As String
Fold = ("C:\Users\Accounts\Desktop\Test")
Name = ActiveSheet.Range("G3").Value & " " & ActiveSheet.Range("C3").Value
Path = Fold & Application.PathSeparator & Name & ".jpg"
With ActiveSheet
Set CopyRange = Range("A1:H43")
If Not CopyRange Is Nothing Then
Application.ScreenUpdating = False
ExportName = Path
If Not ExportName = "False" Then
CopyRange.Copy
.Pictures.Paste
Set Pic = .Pictures(.Pictures.Count)
Set ChO = .ChartObjects.Add(Left:=10, Top:=10, Width:=Pic.Width, Height:=Pic.Height)
Application.CutCopyMode = False
Do
DoEvents
Pic.Copy
DoEvents
ChO.Chart.Paste
DoEvents
i = i + 1
Loop Until (ChO.Chart.Shapes.Count > 0 Or i > 50)
ChO.Chart.Export Filename:=ExportName, Filtername:="JPG"
ChO.Delete
Pic.Delete
End If
Application.ScreenUpdating = True
End If
End With
End With
Next rCl
End With
MsgBox "All payslips have been exported successfully to " & Fold
End Sub
