Save range of cells to clipboard as image

Nate62246

New Member
Joined
Nov 11, 2020
Messages
8
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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?

VBA Code:
'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
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
The template may work if I can use once for the xlsm and once for the jpg.

I added save function part of the code to before the FCF.Range part. This solved the issue, of the copy paste function working correctly. When I did this, it allowed the copy paste code to work flawlessly every time. However in saving both of these to the Environ("userprofile") worked for me, but unfortunately only worked for 2 of the other 5 that tried it. All others it errored out as location not found.

section for xslm to save and reset for copy paste to work, allowing sht.shapes.count to equal 3
VBA Code:
'Create folder location
    myfoldername = Environ("userprofile") & "\Desktop\Facility Care Forms_Temp"
'create file name
    myfilename = "Facility Care Form-CT Suite.xlsm"
'Check to see if folder name exists already.  If not, create it
    If Dir(myfoldername, vbDirectory) = "" Then MkDir myfoldername
'Save file
    ActiveWorkbook.SaveAs Filename:=myfoldername & "\" & myfilename, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


section for jpg to save and be available on clipboard
Code:
 
Upvote 0
Not sure if section for jpg to save and be available on clipboard copied to message board
VBA Code:
'Create folder location
    myfoldername = Environ("userprofile") & "\Desktop\Facility Care Forms_Temp"
'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
 
Upvote 0
Ok here's where I am at. The above folder location code works as it should. The errors I am receiving from other users is because they are working on remote desktops and the file structure is different from mine. To solve for this, I modified myfoldername to: myfoldername = "C:\TempFolder"

To correct the issue of sht.shapes.count not showing a consistent value, I have trigged the file to be saved to the temp folder prior to doing the sht.shapes.count.

File is working correctly now. Thanks for all the help everyone!
 
Upvote 0

Forum statistics

Threads
1,212,929
Messages
6,110,743
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top