perven,
Попробуйте так:
[vba]Код
Sub nnn()
Dim pic As Shape
Dim nm$
Dim m As Double
Dim a As Chart
If Cells(2, 5) <> "" Then
m = Cells(2, 5)
Else
m = 1
End If
'-----------------------
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveSheet
For Each pic In .Shapes
If pic.Type = 3 Or pic.Type = 6 Then
pic.Copy
nm = ThisWorkbook.Path & "\" & pic.Name & ".jpg"
With .ChartObjects.Add(0, 0, pic.Width, pic.Height).Chart
.ChartArea.Border.LineStyle = 0
.Parent.Select
.Paste
'''''''''''
.ChartArea.Height = .PlotArea.Height * m
.ChartArea.Width = .PlotArea.Width * m
'''''''''''
.Export Filename:=nm, FilterName:="JPG"
.Parent.Delete
End With
End If
Next
End With
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Beep
End Sub
[/vba]