Excel cell to png

Sub ExportScreenShot ' Const FName As String = "C:\temp\Concern Screenshot .jpg" Dim pic_rng As Range Dim ShTemp As Worksheet Dim ChTemp As Chart Dim PicTemp As Picture

Dim sFileName         As String ' = "C:\TEMP\export.png" Dim sFolder As String Dim rng             As Range Dim shtTemp         As Worksheet Dim chtTemp         As Chart Dim sCell As String Dim oCht As Chart sFileName = ActiveSheet.Range("c18").Value sFolder = ActiveSheet.Range("c19").Value sCell = ActiveSheet.Range("c17").Value Application.ScreenUpdating = False Set pic_rng = Worksheets("Melissa").Range(sCell & ":" & sCell) Set ShTemp = Worksheets.Add Charts.Add ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name Set ChTemp = ActiveChart pic_rng.CopyPicture Appearance:=xlPrinter, Format:=xlPicture 'pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture -- does not fill image ChTemp.Paste Set PicTemp = Selection With ChTemp.Parent '       .Width = PicTemp.Width .Width = PicTemp.Width * 0.6 .Height = PicTemp.Height End With ChTemp.Export Filename:=sFolder & sFileName & ".png", FilterName:="png" 'UserForm1.Image1.Picture = LoadPicture(FName) 'Kill FName Application.DisplayAlerts = False ShTemp.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub