Option Explicit
Sub Exportrangetopicture(oWs As Worksheet, rng As String, num As Integer)
'Hides alerts
Application.DisplayAlerts = False
'Dim oWs As Worksheet
Dim oRng As range
Dim oChrtO As ChartObject
Dim lWidth As Long, lHeight As Long
'Set oWs = sheets("AREA")
Set oRng = oWs.range(rng).CurrentRegion
oRng.CopyPicture xlScreen, xlPicture
lWidth = oRng.Width
lHeight = oRng.Height
Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
oChrtO.Activate
With oChrtO.Chart
.Paste
.Export Filename:="C:\Users\allso\Desktop\new vba projects\temp" & num & ".jpg", Filtername:="JPG"
End With
oChrtO.Delete
'shows alerts
Application.DisplayAlerts = True
End Sub
Sub callingfunc()
Workbooks.Open "C:\Users\allso\Desktop\new vba projects\new project subham brother\DPR NOV 2020.xlsb"
Dim ws As Worksheet
Set ws = Workbooks("DPR NOV 2020.xlsb").sheets("AREA")
Call Exportrangetopicture(ws, "J2", 1)
Set ws = Nothing
Set ws = Workbooks("DPR NOV 2020.xlsb").sheets("Zone")
Call Exportrangetopicture(ws, "H1", 2)
Workbooks("DPR NOV 2020.xlsb").Close SaveChanges:=True
End Sub
Tuesday, December 8, 2020
Convert excel range to a picture using VBA
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment