Как поправить код?

[elf80]

Доброго времени суток уважаемые! Необходима ваша помощь. Имеется код сохранения листа Excel в отдельную книгу и в определённую директорию. Вопрос: как поправить код, что-бы сохранялись значения вместо формул (ну и соответственно форматирование)

Вот собственно код, нашел и немного переделал, а дальше не могу понять как сохранить только значения. Спасибо!
К сожалению файл выложить не могу ввиду конфиденциальности информации.


Sub СохранитьЛистВФайл()
On Error Resume Next
' путь к папке, в которую по-умолчанию будет предложено сохранить файл
Folder$ = "C:\Documents and Settings\user\Рабочий стол\Сводки\Архив\Доклад": MkDir Folder$
ChDrive Left(Folder$, 1): ChDir Folder$ ' выбираем стартовую папку
' формируем имя файла из текста ячеек
Filename = [a1] & ".xlsx"

' копируем активный лист (при этом создаётся новая книга)
Err.Clear: Sheets("доклад").Copy: DoEvents

If Err Then Exit Sub ' произошла какая-то ошибка при попытке копирования листа

' убеждаемся, что активной книгой является копия листа
If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
' сохраняем файл под заданным именем в формате XLSX (xlOpenXMLWorkbook - Excel 2007)
ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
' закрываем сохранённый файл
ActiveWorkbook.Close False
End If
'скрываем лист после сохранения в архиве
Sheets("доклад").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub

По возможности сохранить лист без макросов и кнопки (имеется на листе оригинала)

[SAS888]

Перед тем, как сохранять созданную книгу, выполните

Dim x, y As Shape
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
For Each y In ActiveSheet.Shapes: y.Delete: Next
On Error Resume Next
For Each x In ActiveWorkbook.VBProject.VBComponents
    Select Case x.Type
        Case 1 To 3: x.Collection.Remove x
        Case 100: x.CodeModule.DeleteLines 1, x.CodeModule.CountOfLines
    End Select
Next

В результате, все ссылки, формулы и т. д. будут заменены их значениями, а также будут удалены все стандартные модули, модули класса, UserForm, программный код из всех модулей листа, книги и все объекты на рабочем листе.

[elf80]

Спасибо SAS888, я правильно вставил код? Если да - то у меня в оригинале формулы меняются на значения, а в сохранённом листе формулы остаются. Что не так? Сам не разберусь, VBA только изучаю.

Sub СохранитьЛистВФайл()
On Error Resume Next
' путь к папке, в которую по-умолчанию будет предложено сохранить файл
Folder$ = "C:\Documents and Settings\user\Рабочий стол\Сводки\Архив\Доклад": MkDir Folder$
ChDrive Left(Folder$, 1): ChDir Folder$ ' выбираем стартовую папку
' формируем имя файла из текста ячеек
Filename = [a1] & ".xlsx"
' копируем активный лист (при этом создаётся новая книга)
Err.Clear: Sheets("доклад").Copy: DoEvents
If Err Then Exit Sub ' произошла какая-то ошибка при попытке копирования листа
' убеждаемся, что активной книгой является копия листа
If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
Dim x, y As Shape
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
For Each y In ActiveSheet.Shapes: y.Delete: Next
On Error Resume Next
For Each x In ActiveWorkbook.VBProject.VBComponen ts
Select Case x.Type
Case 1 To 3: x.Collection.Remove x
Case 100: x.CodeModule.DeleteLines 1, x.CodeModule.CountOfLines
End Select
Next
' сохраняем файл под заданным именем в формате XLSX (xlOpenXMLWorkbook - Excel 2007)
ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
' закрываем сохранённый файл
ActiveWorkbook.Close False
End If
'скрываем лист после сохранения в архиве
Sheets("доклад").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub

[SAS888]

Попробуйте так:

Sub СохранитьЛистВФайл()
    Dim x, y As Shape: On Error Resume Next
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Folder$ = "C:\Documents and Settings\user\Рабочий стол\Сводки\Архив\Доклад": MkDir Folder$
    Filename = Folder$ & "\" & [a1] & ".xlsx"
    Sheets("доклад").Copy: DoEvents
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    For Each y In ActiveSheet.Shapes: y.Delete: Next
    For Each x In ActiveWorkbook.VBProject.VBComponents
        Select Case x.Type
            Case 1 To 3: x.Collection.Remove x
            Case 100: x.CodeModule.DeleteLines 1, x.CodeModule.CountOfLines
        End Select
    Next
    ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
    ActiveWorkbook.Close False
    Sheets("доклад").Visible = False
 End Sub

Если не получится - прикрепите проблемный файл.

[Скрипт]

On Error Resume Next нужно всегда сопровождать On Error GoTo 0. Ведь пропустить ошибку нужно в каком-то месте кода, а не во всём коде.

[SAS888]

Сообщение от Скрипт

On Error Resume Next нужно всегда сопровождать On Error GoTo 0. Ведь пропустить ошибку нужно в каком-то месте кода, а не во всём коде.

Совершенно верно. Я не знаю, зачем он здесь вообще нужен. Возможно, что это какой-то фрагмент кода автора темы, а игнорирование ошибки осталось от полного кода...

[elf80]

SAS888 к сожалению проблема осталась, т.е. в оригинале формулы удаляются, а в копии сохраняются и пропал запрос на перезапись файла копии листа при наличии такого же в папке. Файл не могу выложить для всеобщего обозрения, информация конфиденциальная.

[elf80]

Вот часть файла, думаю будет понятно

[SAS888]

1. Запрос на перезапись я специально убрал. Если же Вам это надо, то удалите из кода

Application.DisplayAlerts = False

2. Работу кода проверил. Все ОК. После копирования листа в новую книгу, он становится активным. Далее мы с ним и работаем. Скорее всего, проблема в том, что копируемый лист очень "тяжелый". Поэтому, макрос продолжает работать еще в то время, как активным является копируемый лист.
Если это так, то Вам должна помочь задержка выполнения последующего кода. Для этого, вместо DoEvents вставьте строку:

For i = 1 To 100000: DoEvents: Next

Счетчик цикла подберите экспериментально.
3. Можно, конечно, прикрепить не оригинальный файл, а подобный. Но, боюсь, что ели причина в вышеупомянутой проблеме, то "легкий" файл не даст истинной картины...

[elf80]

Сейчас попробую. В файле, что я выложил получается та же самая история, т.е. в оригинале формулы затираются значениями