Tuesday, December 8, 2020

Convert excel range to a picture using VBA

 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

No comments:

Post a Comment