Здравствуйте уважаемые программисты! Имеется рабочая книга с расчетными формулами.Хочется автоматизировать процедуру сохранения листа, в качестве новой книги, с последующим удалением формул в новой сохраненной книге, минуя установленную защиту в рабочей книге. Прилагаю файл с макросами: 1) на сохранение листа 2) на удаление формул Заранее спасибо!
Здравствуйте уважаемые программисты! Имеется рабочая книга с расчетными формулами.Хочется автоматизировать процедуру сохранения листа, в качестве новой книги, с последующим удалением формул в новой сохраненной книге, минуя установленную защиту в рабочей книге. Прилагаю файл с макросами: 1) на сохранение листа 2) на удаление формул Заранее спасибо!tasdel
Не очень хороший вариант, но может подойдет? [vba]
Код
Private Sub Сохранение() Dim wb1 As Workbook On Error Resume Next Const REPORTS_FOLDER = "Отчёты по тепловым счетчикам\" MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER Filename = Application.GetSaveAsFilename("отчёт.xls", "Отчёты Excel (*.xls*),", , _ "Введите имя файла для сохраняемого отчёта", "Сохранить") If VarType(Filename) = vbBoolean Then Exit Sub Filename = Filename & "xls" On Error Resume Next Range("A1:AA9999").Copy Set wb1 = Workbooks.Add With wb1.Sheets(1).Range("A1") .PasteSpecial (xlPasteColumnWidths) .PasteSpecial (xlPasteValues) .PasteSpecial (xlPasteFormats) End With wb1.SaveAs Filename, xlWorkbookNormal End Sub
[/vba]
Не очень хороший вариант, но может подойдет? [vba]
Код
Private Sub Сохранение() Dim wb1 As Workbook On Error Resume Next Const REPORTS_FOLDER = "Отчёты по тепловым счетчикам\" MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER Filename = Application.GetSaveAsFilename("отчёт.xls", "Отчёты Excel (*.xls*),", , _ "Введите имя файла для сохраняемого отчёта", "Сохранить") If VarType(Filename) = vbBoolean Then Exit Sub Filename = Filename & "xls" On Error Resume Next Range("A1:AA9999").Copy Set wb1 = Workbooks.Add With wb1.Sheets(1).Range("A1") .PasteSpecial (xlPasteColumnWidths) .PasteSpecial (xlPasteValues) .PasteSpecial (xlPasteFormats) End With wb1.SaveAs Filename, xlWorkbookNormal End Sub
Потому, что копируется диапазон A1:AA9999. А если у Вас на копируемом листе будет бОльший диапазон? Сразу скажу, что копировать вообще все-все не стОит
Потому, что копируется диапазон A1:AA9999. А если у Вас на копируемом листе будет бОльший диапазон? Сразу скажу, что копировать вообще все-все не стОит_Boroda_
_Boroda_, Почему-то не хочет работать макрос в моей программке? Примечание:1)книга двоичная 2) диапазон небольшой А на выложенном файле работает.
_Boroda_, Почему-то не хочет работать макрос в моей программке? Примечание:1)книга двоичная 2) диапазон небольшой А на выложенном файле работает.tasdel