To Save Ranges as picture
Note: Sometimes is not working with another excel version
'Option Explicit
Private Sub SaveRngAsJPG(rng As Range, FileName As String)
On Error Resume Next
Dim Cht As Chart, bScreen As Boolean, Shp As Shape
bScreen = Application.ScreenUpdating
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
Set Cht = Workbooks.Add(xlChart).Charts(1)
Cht.ChartArea.Clear
rng.CopyPicture xlScreen, xlPicture
Cht.Paste
With Cht.Shapes(1)
.Left = 0
.Top = 0
.Width = Cht.ChartArea.Width
.Height = Cht.ChartArea.Height
End With
Cht.Export FileName, "JPEG", False
Cht.Parent.Close False
Application.ScreenUpdating = False
End Sub
Sub TestIt1()
Dim rng As Range, Fn As String, s As String
Application.Calculation = xlCalculationAutomatic
Set rng = Sheets("Payslip").Range("b14:e39")
Fn = Sheets("Payslip").Range("b10").Value
s = Sheets("Payslip").Range("g19").Value
SaveRngAsJPG rng, Fn & "Payslip " & s
End Sub
No comments:
Post a Comment