Save range of cells to clipboard as image

[Nate62246]

I am trying to use a bit of VBA to copy a range of cells as an image to paste into a non-Microsoft program. The code below works on occasion but errors out 90% of the time on "sh.Copy". It appears as though it isn't always picking up my range of cells and defining them as "sh".
What am I missing?

'create jpg for selected range
'==================================================

Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, sh As Shape
Dim fileSaveName As Variant, pic As Variant

'Sets the Excel Copy Range
     FCF.Range("B1:G" & (FCF.Range("B3").End(xlDown).Row)).SpecialCells(xlCellTypeVisible).Select

'Create temporary chart as canvas
Set sht = Selection.Worksheet
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Selection Copy
sht.Pictures.Paste.Select
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.Copy
tmpChart.ChartArea.Select
tmpChart.Paste

'Create folder location
myfoldername = Environ("userprofile") & "\Desktop\Facility Care Forms"

'create file name
myfilename = Sheets("Facility Care Form").Range("B2 ").Text & _
Format(Now(), " mmm-dd-yyyy hhmmss") & ".jpg"

'Check to see if folder name exists already. If not, create it
If Dir(myfoldername, vbDirectory) = "" Then MkDir myfoldername

'Save file
    fileSaveName = myfoldername & "\" & myfilename

'Save chart image to file
If fileSaveName <> False Then
tmpChart.Export Filename:=fileSaveName, FilterName:="jpg"
End If

'Clean up
sht.Cells(1, 1).Activate
sht.ChartObjects(sht.ChartObjects.Count).Delete
sh.Delete

 

[yky]

What error did you get? Nothing was pasted? This seems to be a common problem. I ended up putting the copy & paste code in a loop to make sure the range was pasted.

Do
sh.Copy
tmpChart.Paste
Loop Until tmpChart.Shapes.Count=1

 

[Nate62246]

I hopped in an ran it again just now and it worked a few times and then I opened another part of the form then the error:
Run-time error '-2147467259 (80004005)'
method 'Select' of object 'Shape' failed

I will give your loop method a try.
Thanks!

 

[Nate62246]

I tried several variations of the loop code occasionally recognized =0, but still errors out on "sh..Copy".
I may not be looping in the correct place. I'm sort of new to this.

'create jpg for selected range
'==================================================

Dim tmpChart As Chart, n As Long, shCount As Long, sht As Worksheet, sh As Shape
    Dim fileSaveName As Variant, pic As Variant

'Sets the Excel Copy Range
    FCF.Range("B1:G" & (FCF.Range("B3").End(xlDown).Row)).SpecialCells(xlCellTypeVisible).Select

'Create temporary chart as canvas
Set sht = Selection.Worksheet
Selection.CopyPicture appearance:=xlScreen, Format:=xlPicture


'Selection.Copy
sht.Pictures.Paste.Select
[B][COLOR=rgb(184, 49, 47)]Set sh = sht.Shapes(sht.Shapes.Count) [/COLOR][/B] '<----this seems to be what it is not recognizing. When it gets to "sh.Copy" there is nothing in sh.Copy.
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.Select
' sh.Copy
' tmpChart.ChartArea.Select
' tmpChart.Paste

Do
[COLOR=rgb(184, 49, 47)][B]sh.Copy          '<----error takes me to this highlighted location in code[/B][/COLOR]
tmpChart.Paste
Loop Until tmpChart.Shapes.Count = 1

 

[yky]

I hopped in an ran it again just now and it worked a few times and then I opened another part of the form then the error:
Run-time error '-2147467259 (80004005)'
method 'Select' of object 'Shape' failed

I will give your loop method a try.
Thanks!

Do you know at which line the error occurred?

 

[yky]

I tried several variations of the loop code occasionally recognized =0, but still errors out on "sh..Copy".
I may not be looping in the correct place. I'm sort of new to this.

What does it mean by "errors out on sh..Copy"? Would you elaborate on that?

 

[Nate62246]

The code errors out or highlights yellow when I click "debug": Row 22 below (sh.Copy).

The way I understand, earlier in the code "sh" is defined or Set as sht.Shapes(sht.Shapes.Count)

The shapes and count is new to me, so i'm not 100% understanding how that is capturing the correct shape within the form. My guess it that it should be getting the shape from the selection previous (FCF.Range…...Select).

So the really odd part is that sometimes the code does exactly what it is supposed to.
1. selects the correct range of cells
2. copies them and defines them as "sh" and is a picture
3. creates a chart
4. paste the "sh" image to the chart area
5. saves the chart as a .jpg in location
6. leaves the .jpg on the clipboard
7. allows me to paste the .jpg image wherever I wish (by right click paste or CTRL+V)

Other times it does not do this and errors out on the "sh.Copy" line of the code.
I seem to have isolated one instance when it works. After I get all information typed into the excel range and then Save the file. After this it will work until I clear out the range and start again.
Not sure what state Excel is in directly after a save though.

    FCF.Range("B1:G" & (FCF.Range("B3").End(xlDown).Row)).SpecialCells(xlCellTypeVisible).Select

'Create temporary chart as canvas
Set sht = Selection.Worksheet
Selection.CopyPicture 'appearance:=xlScreen, Format:=xlPicture


'Selection.Copy
sht.Pictures.Paste.Select
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.Select
sh.Copy             '[B][COLOR=rgb(184, 49, 47)]<----- This is the line the code errors out on (or) is HIGHLIGHTED rather, when I click debug[/COLOR][/B]
tmpChart.ChartArea.Select
tmpChart.Paste

 

[yky]

The code errors out or highlights yellow when I click "debug": Row 22 below (sh.Copy).

The way I understand, earlier in the code "sh" is defined or Set as sht.Shapes(sht.Shapes.Count)

The shapes and count is new to me, so i'm not 100% understanding how that is capturing the correct shape within the form. My guess it that it should be getting the shape from the selection previous (FCF.Range…...Select).

sht.Shapes(sht.Shapes.Count) is the shape last pasted. In your case, "sht.Pictures.Paste.Select" is the last paste command. It pastes the FCF range. So, sh is set to the picture of the range.

So the really odd part is that sometimes the code does exactly what it is supposed to.
1. selects the correct range of cells
2. copies them and defines them as "sh" and is a picture
3. creates a chart
4. paste the "sh" image to the chart area
5. saves the chart as a .jpg in location
6. leaves the .jpg on the clipboard
7. allows me to paste the .jpg image wherever I wish (by right click paste or CTRL+V)

Other times it does not do this and errors out on the "sh.Copy" line of the code. I seem to have isolated one instance when it works. After I get all information typed into the excel range and then Save the file. After this it will work until I clear out the range and start again. Not sure what state Excel is in directly after a save though.

In my case, I have the copy & paste command in a loop of 147. I got random blank pictures, indicating the copy command failed randomly.

I reviewed my code and found that I have another loop just for copying. Try this:

On Error Resume Next
Do
sh.copy
Loop Until Err.Number = 0
On Error Goto 0

When testing your code, I got a different error. It's at this line:

tmpChart.Parent.Border.LineStyle = 0

The error message is "Unable to set the LineStyle property of the Border class." Did you get it?

 

[Nate62246]

Sorry I have gotten sidetracked from this project for a bit. Looking back at this, I have not returned the "LineStyle property of the Border class." error.

I did try plugging in the last piece of VBA you suggested. It works when I first open the document, but then if I refresh my form it goes into a continuous loop I am unable to get out of.
I tried stepping through the code to see what may be different from when it does work to when it does not. One item I noticed is the VBA
sht.Pictures.Paste.Select
Set sh = sht.Shapes(sht.Shapes.Count)

sht.Shapes(sht.Shapes.Count shows as 4 when erroring... shows as 3 when working correctly
I see this when stepping through the code with F8 and hovering over the code just after that line executes.

Is there a way to save the file as possibly a temp file before running the shapes count piece of the code?

Thanks again for all your help on this!

 

[yky]

Excel allows you to save a file as a template. Would that work for you?