Function SavePicToFile(foto, area)
Dim oWs As Worksheet
Dim oRng As Range
Dim oChrtO As ChartObject
Dim lWidth As Long, lHeight As Long
Set oWs = ActiveSheet
Set oRng = oWs.Range(area)
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:=foto, Filtername:="JPG"
End With
oChrtO.Delete
End Function
Sub test()
foto = "d:\Foto" & ".jpeg"
area = "A107:E117"
A = SavePicToFile(foto, area)
End Sub
