1

I'Ve got a really strange error/break in my code when the line "ThisWorkbook.Sheets("PD").Pictures.Paste(Link:=False).Select" is executed.

The reason it is strange is that this error only happens sometimes? The first time the code runs through its first pass, sometimes i get the error sometimes not... The second time time i run the loop, i always get an error The third time, i think it usually passes?!

In all 3 cases, if it does decide to stop, I get an error 1004 MsgBox and the line is highlighted in the debugger but then if I close the error message box, change nothing and just click the Play button. The code just carries on happily with no further errors lol.

My full code is huge so I cant paste it all but im hoping if I just paste the function where the error occurs im hoping one of you guys could suggest something ive not looked for or tried!

The line cant be wrong because when I click play after it breaks, it works?

Function SaveRangeAsPicture(ImgName As String)

Call UnprotectAll

'PURPOSE: Save a selected cell range as a JPG file to computer's desktop
'SOURCE: www.thespreadsheetguru.com

Dim cht As ChartObject
Dim ActiveShape As Shape

ThisWorkbook.Sheets("Part Database").Select

ThisWorkbook.Sheets("Part Database").Shapes.Range(Array(ImgName)).Select

'Copy/Paste Cell Range as a Picture ***(THIS IS WHERE ERROR OCCURS, 2ND LINE DOWN)***
  Selection.Copy
  ThisWorkbook.Sheets("Part Database").Pictures.Paste(link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
  
'Create a temporary chart object (same size as shape)
  Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, _
    Top:=ActiveCell.Top, _
    Height:=ActiveShape.Height)

'Format temporary chart to have a transparent background
  cht.ShapeRange.Fill.Visible = msoFalse
  cht.ShapeRange.Line.Visible = msoFalse
    
'Copy/Paste Shape inside temporary chart
  ActiveShape.Copy
  cht.Activate
  ActiveChart.Paste
  
'Save chart to User's Desktop as JPG File
  cht.Chart.Export "C:\Users\" & Environ("Username") & "\Desktop\" & ActiveShape.Name & ".jpg"

'Replace the Picture on the Userform With the one from the part database

 Call Add_Dynamic_Image2(ActiveShape.Name)
 
'Delete temporary Chart
cht.Delete
  
'Delete temporary image file on desktop
Kill ("C:\Users\" & Environ("Username") & "\Desktop\" & ActiveShape.Name & ".jpg")
  
'Delete Active Shape
ActiveShape.Delete

End Function

Thanks in advance!

So the things ive tried already:

  • Made sure the variable (ImgName) being passed to the function is correct, and it is.
  • Ive put the lines DoEvents in various places to no avail.
  • Ive tried writing the line where the error occurs in various different ways.
  • Ive checked that the name of the Physical image object matches the variable ImgName and it does.

UPDATE - MORE INFO: What this part of the code is aiming to do is not to copy and paste a picture from a spreadsheet into another spreadsheet, but to save a picture as a .jpg file temporarily somewhere on the users PC so I can then dynamically change the picture on a userform and setting Userform.Image1.Picture to the temporary file....

Then it deletes the .jpg on the desktop and clears the charts from the excel workbook that I used to create the .jpg.

Chris Woodhouse
  • 21
  • 3
  • Consider [not using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code – cybernetic.nomad Apr 21 '23 at 17:17
  • Your method is called `SaveRangeAsPicture` but it seems like you're really trying to export an existing shape and not a Range? – Tim Williams Apr 21 '23 at 18:04
  • @cybernetic.nomad - I read the thread, I've had a go at trying to avoid using select. but I don't know how to rewrite my code to achieve that. I tried to "set" the active shape dimensioning it as both a range and as a shape, and I'm getting an error in each case, I've also looked at passing the variable to the function as a range and as a shape but I don't know how to edit my code to accommodate. I'm trying to keep all of the image files self-contained within the workbook because a lot of different users will use this program and I don't think I could refer to external file paths reliably. – Chris Woodhouse Apr 25 '23 at 11:18
  • @Tim Williams - Yes you may be right about the name of the function and I may change it at some stage, I just found the closest code I could from google and changed the code within the function to do what I wanted it to do. – Chris Woodhouse Apr 25 '23 at 11:24

2 Answers2

1

Functions are not used to copy and paste, just used for calculations.

You can copy and paste a named picture. When you paste the picture, it becomes the selected pic

    Sub CopyPic()

ThisWorkbook.Sheets("Part Database").Shapes("PictureName").Copy
Range("F16").PasteSpecial
 With Selection
 .Name = "NewPic"
 .Left = Range("F16").Left
 .Top = Range("F16").Top
 End With
    
    
End Sub

If you have an activecell with the named picture, you can use the following code.

    Sub SubCopyNamedPic()

ThisWorkbook.Sheets("Part Database").Shapes(ActiveCell.Value).Copy
Range("F16").PasteSpecial
 With Selection
 .Name = "NewPic"
 .Left = Range("F16").Left
 .Top = Range("F16").Top
 End With
    
    
End Sub
Davesexcel
  • 6,896
  • 2
  • 27
  • 42
  • Hey thanks for the comment :) ! I think I need to provide some additional context. What that part of the code is aiming to do is not to copy and paste a picture from a spreadsheet into another spreadsheet, but to save a picture as a .jpg file temporarily somewhere on the users PC so I can then dynamically change the picture on a userform and setting Userform.Image1.Picture to the temporary file.... and then it deletes the .jpg on the desktop and clears the charts from the excel workbook that I used to create the .jpg. Hope that all sort of made sense? – Chris Woodhouse Apr 25 '23 at 10:46
  • The only thing i could find that worked was on a website where a code was written, and I've just edited it a bit so it suits my use case. I couldn't find an alternative to this method on google anywhere. – Chris Woodhouse Apr 25 '23 at 10:48
0

One theory I had was that maybe Excel was getting ahead of itself and trying to paste the image before it was able to copy the picture to memory.

I added a wait duration of 1 second, and I'm no longer getting any issues.

However... I don't like using Wait functions particularly, because maybe other users have PC's that are much slower and require a longer wait time or something.

So ill post the code that "Works" below, but id still be interested to see if anyone could suggest a solution that doesn't rely on .select and .application.wait:

Sub SaveRangeAsPicture(ImgName As String)

Call UnprotectAll

'PURPOSE: Save a selected cell range as a JPG file to computer's desktop
'SOURCE: www.thespreadsheetguru.com

Dim cht As ChartObject
Dim ActiveShape As Shape

ThisWorkbook.Sheets("Part Database").Select

ThisWorkbook.Sheets("Part Database").Shapes.Range(Array(ImgName)).Select
'Set ActiveShape = ThisWorkbook.Sheets("PartDatabase").Shapes.Range(Array(ImgName))

'Copy/Paste Cell Range as a Picture
  Selection.Copy
  Application.Wait (Now + TimeValue("0:00:01"))
  ThisWorkbook.Sheets("Part Database").Pictures.Paste(link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)

'Create a temporary chart object (same size as shape)
Set cht = ActiveSheet.ChartObjects.Add( _
Left:=ActiveCell.Left, _
Width:=ActiveShape.Width, _
Top:=ActiveCell.Top, _
Height:=ActiveShape.Height)

'Format temporary chart to have a transparent background
cht.ShapeRange.Fill.Visible = msoFalse
cht.ShapeRange.Line.Visible = msoFalse

'Copy/Paste Shape inside temporary chart
ActiveShape.Copy
cht.Activate
ActiveChart.Paste

'Save chart to User's Desktop as JPG File
cht.Chart.Export "C:\Users\" & Environ("Username") & "\Desktop\" & 
ActiveShape.Name & ".jpg"

'Replace the Picture on the Userform With the one from the part database

Call Add_Dynamic_Image2(ActiveShape.Name)

'Delete temporary Chart
 cht.Delete

'Delete temporary image file on desktop
 Kill ("C:\Users\" & Environ("Username") & "\Desktop\" & ActiveShape.Name & ".jpg")

'Delete Active Shape
ActiveShape.Delete

End Sub
Chris Woodhouse
  • 21
  • 3