The_Prist, Классный рецепт. Спасибо!
В результате выбрал модуль, который сохраняет все на поверхности выбранного диапазона ячеек и прикрутил его к кнопке.
Только посоветуйте как задать отдельную папку для сохранения скриншотов
Код модуля |
|---|
| Код |
|---|
'---------------------------------------------------------------------------------------
' Module : mSaveObjectAsPicture
' DateTime : 05.03.2011 18:22
' Author : The_Prist(Щербаков Дмитрий)
' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' http://www.excel-vba.ru
' Purpose : http://www.excel-vba.ru/index.php?file=Tips_Macro_Save_Object_As_Picture
'---------------------------------------------------------------------------------------
Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : Range_to_Picture
' DateTime : 24.06.2012 16:09
' Author : The_Prist(Щербаков Дмитрий)
' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
' http://www.excel-vba.ru
' Purpose : сохранение диапазона в файл GIF
'---------------------------------------------------------------------------------------
Sub Range_to_Picture()
Dim sName As String, wsTmpSh As Worksheet
If TypeName(Selection) <> "Range" Then
MsgBox "Выделенная область не является диапазоном!", vbCritical, "www.excel-vba.ru"
Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Selection
.CopyPicture
Set wsTmpSh = ThisWorkbook.Sheets.Add
sName = ActiveWorkbook.FullName & "_" & ActiveSheet.Name & "_Range"
With wsTmpSh.ChartObjects.Add(0, 0, .Width, .Height).Chart
.ChartArea.Border.LineStyle = 0
.Paste
.Export Filename:=sName & ".png", FilterName:="PNG"
.Parent.Delete
End With
End With
wsTmpSh.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
|
|
