Зашел на сайт. Почитал сообщение о владельце... СОБОЛЕЗНУЕМ Что будет с сайтом?
Помогите пож. написать макрос, т.к. с ними пока не очень, с такой возможностью: на защищенном листе с формулами, нужно сохранить лист, чтобы он был сохранен без формул в отдельный файл, но при этом изначальный файл что бы опять стал защищенным. Нашел и пользуюсь макросом который выполняет мои задачи, только не могу сделать чтобы изначальный файл оставался защищенным. Заранее благодарю.
Пользуюсь таким: [vba]
Код
Sub сохранитьлист1() ActiveSheet.Unprotect Password:="111" 'Снять защиту с паролем 111 Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n Ar = Array(1) 'порядковые номера сохраняемых листов с формулами ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1) For Each Sh In ThisWorkbook.Worksheets ArAll(n) = Sh.Index n = n + 1 Next ThisWorkbook.Worksheets(ArAll).Copy ActiveWorkbook.Sheets(Ar(0)).Activate Application.Volatile Application.Calculate Application.ScreenUpdating = False For Each n In Ar With ActiveWorkbook.Worksheets(n).UsedRange.Cells .Value = .Value End With Next Erase ArAll: n = 0 ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1)) For Each Sh In ActiveWorkbook.Worksheets If IsError(Application.Match(Sh.Index, Ar, 0)) Then ArAll(n) = Sh.Index n = n + 1 End If Next Application.DisplayAlerts = False ActiveWorkbook.Worksheets(ArAll).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Dialogs(xlDialogSaveAs).Show End Sub
[/vba]
Зашел на сайт. Почитал сообщение о владельце... СОБОЛЕЗНУЕМ Что будет с сайтом?
Помогите пож. написать макрос, т.к. с ними пока не очень, с такой возможностью: на защищенном листе с формулами, нужно сохранить лист, чтобы он был сохранен без формул в отдельный файл, но при этом изначальный файл что бы опять стал защищенным. Нашел и пользуюсь макросом который выполняет мои задачи, только не могу сделать чтобы изначальный файл оставался защищенным. Заранее благодарю.
Пользуюсь таким: [vba]
Код
Sub сохранитьлист1() ActiveSheet.Unprotect Password:="111" 'Снять защиту с паролем 111 Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n Ar = Array(1) 'порядковые номера сохраняемых листов с формулами ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1) For Each Sh In ThisWorkbook.Worksheets ArAll(n) = Sh.Index n = n + 1 Next ThisWorkbook.Worksheets(ArAll).Copy ActiveWorkbook.Sheets(Ar(0)).Activate Application.Volatile Application.Calculate Application.ScreenUpdating = False For Each n In Ar With ActiveWorkbook.Worksheets(n).UsedRange.Cells .Value = .Value End With Next Erase ArAll: n = 0 ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1)) For Each Sh In ActiveWorkbook.Worksheets If IsError(Application.Match(Sh.Index, Ar, 0)) Then ArAll(n) = Sh.Index n = n + 1 End If Next Application.DisplayAlerts = False ActiveWorkbook.Worksheets(ArAll).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Dialogs(xlDialogSaveAs).Show End Sub
garbol, Доброго времени суток. Раздобыл я ваш файл пример. Для вашего случая если у вас всего один лист в книге как в примере то при использования вашего макроса что у вас в файле то будет ошибка, так как у вас нет массива листов. Вот код только для одного листа в книге:
[vba]
Код
Option Explicit
' Сохранение исходного листа без формул в отдельный файл Sub сохранитьЛист2()
' Снятие защиты с листа ActiveSheet.Unprotect Password:="111" Dim wsIndex As Long Dim newWorkbook As Workbook
' Получаем порядковый номер текущего листа wsIndex = ActiveSheet.Index
' Копируем текущий лист в новую рабочую книгу Set newWorkbook = Workbooks.Add ThisWorkbook.Worksheets(wsIndex).Copy Before:=newWorkbook.Sheets(1)
' Переключаемся на активный лист в новой книге newWorkbook.Sheets(1).Activate
' Заменяем формулы на значения With newWorkbook.Sheets(1).UsedRange.Cells .Value = .Value End With
' Сохраняем новую книгу Application.DisplayAlerts = False newWorkbook.Sheets(2).Delete Application.DisplayAlerts = True Application.Dialogs(xlDialogSaveAs).Show
' Закрываем новую книгу newWorkbook.Close False
' Защищаем исходный лист снова ActiveSheet.Protect Password:="111" End Sub
[/vba]
Я прокомментировал строки кода чтоб вы могли понимать что, куда и зачем. А вот ваш код из поста с комментариями:
[vba]
Код
Option Explicit
' Сохранение исходного листа без формул в отдельный файл Sub сохранитьлист1()
' Снятие защиты с листа ActiveSheet.Unprotect Password:="111"
' Порядковые номера сохраняемых листов с формулами Dim Ar(), ArAll() As Long, Sh As Worksheet, n As Variant Ar = Array(1) ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1)
' Получение порядковых номеров всех листов For Each Sh In ThisWorkbook.Worksheets ArAll(n) = Sh.Index n = n + 1 Next
' Копирование листов с формулами в новую рабочую книгу ThisWorkbook.Worksheets(ArAll).Copy ActiveWorkbook.Sheets(Ar(0)).Activate Application.Volatile Application.Calculate Application.ScreenUpdating = False
' Замена формул на значения на сохраненных листах For Each n In Ar
With ActiveWorkbook.Worksheets(n).UsedRange.Cells .Value = .Value End With
Next
' Удаление ненужных листов из нового файла Erase ArAll: n = 0 ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1))
For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Index, Ar, 0)) Then ArAll(n) = Sh.Index n = n + 1 End If
' Закрываем вновь созданную книгу ActiveWorkbook.Close
' Защита исходного листа снова ActiveSheet.Protect Password:="111" End Sub
[/vba]
Удачи.
garbol, Доброго времени суток. Раздобыл я ваш файл пример. Для вашего случая если у вас всего один лист в книге как в примере то при использования вашего макроса что у вас в файле то будет ошибка, так как у вас нет массива листов. Вот код только для одного листа в книге:
[vba]
Код
Option Explicit
' Сохранение исходного листа без формул в отдельный файл Sub сохранитьЛист2()
' Снятие защиты с листа ActiveSheet.Unprotect Password:="111" Dim wsIndex As Long Dim newWorkbook As Workbook
' Получаем порядковый номер текущего листа wsIndex = ActiveSheet.Index
' Копируем текущий лист в новую рабочую книгу Set newWorkbook = Workbooks.Add ThisWorkbook.Worksheets(wsIndex).Copy Before:=newWorkbook.Sheets(1)
' Переключаемся на активный лист в новой книге newWorkbook.Sheets(1).Activate
' Заменяем формулы на значения With newWorkbook.Sheets(1).UsedRange.Cells .Value = .Value End With
' Сохраняем новую книгу Application.DisplayAlerts = False newWorkbook.Sheets(2).Delete Application.DisplayAlerts = True Application.Dialogs(xlDialogSaveAs).Show
' Закрываем новую книгу newWorkbook.Close False
' Защищаем исходный лист снова ActiveSheet.Protect Password:="111" End Sub
[/vba]
Я прокомментировал строки кода чтоб вы могли понимать что, куда и зачем. А вот ваш код из поста с комментариями:
[vba]
Код
Option Explicit
' Сохранение исходного листа без формул в отдельный файл Sub сохранитьлист1()
' Снятие защиты с листа ActiveSheet.Unprotect Password:="111"
' Порядковые номера сохраняемых листов с формулами Dim Ar(), ArAll() As Long, Sh As Worksheet, n As Variant Ar = Array(1) ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1)
' Получение порядковых номеров всех листов For Each Sh In ThisWorkbook.Worksheets ArAll(n) = Sh.Index n = n + 1 Next
' Копирование листов с формулами в новую рабочую книгу ThisWorkbook.Worksheets(ArAll).Copy ActiveWorkbook.Sheets(Ar(0)).Activate Application.Volatile Application.Calculate Application.ScreenUpdating = False
' Замена формул на значения на сохраненных листах For Each n In Ar
With ActiveWorkbook.Worksheets(n).UsedRange.Cells .Value = .Value End With
Next
' Удаление ненужных листов из нового файла Erase ArAll: n = 0 ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1))
For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Index, Ar, 0)) Then ArAll(n) = Sh.Index n = n + 1 End If
' Сохранение исходного листа без формул в отдельный файл Sub сохранитьлист1()
' Снятие защиты с листа ActiveSheet.Unprotect Password:="111"
' Порядковые номера сохраняемых листов с формулами Dim Ar(), ArAll() As Long, Sh As Worksheet, n As Variant Ar = Array(1) ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1)
' Получение порядковых номеров всех листов For Each Sh In ThisWorkbook.Worksheets ArAll(n) = Sh.Index n = n + 1 Next
' Копирование листов с формулами в новую рабочую книгу ThisWorkbook.Worksheets(ArAll).Copy ActiveWorkbook.Sheets(Ar(0)).Activate Application.Volatile Application.Calculate Application.ScreenUpdating = False
' Замена формул на значения на сохраненных листах For Each n In Ar
With ActiveWorkbook.Worksheets(n).UsedRange.Cells .Value = .Value End With
Next
' Удаление ненужных листов из нового файла Erase ArAll: n = 0 ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1))
For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Index, Ar, 0)) Then ArAll(n) = Sh.Index n = n + 1 End If
' Закрываем вновь созданную книгу ActiveWorkbook.Close
' Защита исходного листа снова ActiveSheet.Protect Password:="111" End Sub
Добрый. Что то стала ошибка выскакивать subscript out of range на эту строку ActiveWorkbook.Worksheets(ArAll).Delete, что это значит, в нете ответа не нашел. Благодарю.
' Сохранение исходного листа без формул в отдельный файл Sub сохранитьлист1()
' Снятие защиты с листа ActiveSheet.Unprotect Password:="111"
' Порядковые номера сохраняемых листов с формулами Dim Ar(), ArAll() As Long, Sh As Worksheet, n As Variant Ar = Array(1) ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1)
' Получение порядковых номеров всех листов For Each Sh In ThisWorkbook.Worksheets ArAll(n) = Sh.Index n = n + 1 Next
' Копирование листов с формулами в новую рабочую книгу ThisWorkbook.Worksheets(ArAll).Copy ActiveWorkbook.Sheets(Ar(0)).Activate Application.Volatile Application.Calculate Application.ScreenUpdating = False
' Замена формул на значения на сохраненных листах For Each n In Ar
With ActiveWorkbook.Worksheets(n).UsedRange.Cells .Value = .Value End With
Next
' Удаление ненужных листов из нового файла Erase ArAll: n = 0 ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1))
For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Index, Ar, 0)) Then ArAll(n) = Sh.Index n = n + 1 End If
' Закрываем вновь созданную книгу ActiveWorkbook.Close
' Защита исходного листа снова ActiveSheet.Protect Password:="111" End Sub
Добрый. Что то стала ошибка выскакивать subscript out of range на эту строку ActiveWorkbook.Worksheets(ArAll).Delete, что это значит, в нете ответа не нашел. Благодарю.garbol
garbol,Прошу Вас не ругаться, но опять продолжаю данную тему, и прошу Вас еще помочь, если это возможно, доработать данный макрос, что бы он удалял условное форматирование на сохраненном листе. Благодарю. Да Ваш код из поста №3 работает на УРА. Благодарю, сразу не разобрался просто.
garbol,Прошу Вас не ругаться, но опять продолжаю данную тему, и прошу Вас еще помочь, если это возможно, доработать данный макрос, что бы он удалял условное форматирование на сохраненном листе. Благодарю. Да Ваш код из поста №3 работает на УРА. Благодарю, сразу не разобрался просто.garbol
' Заменяем формулы на значения а также удаляем условное форматирование With newWorkbook.Sheets(1).UsedRange.Cells .Value = .Value .FormatConditions.Delete End With
[/vba] Я и не сомневался что код рабочий...
[vba]
Код
' Заменяем формулы на значения а также удаляем условное форматирование With newWorkbook.Sheets(1).UsedRange.Cells .Value = .Value .FormatConditions.Delete End With
[/vba] Я и не сомневался что код рабочий...MikeVol
Ученик. Одесса - Украина
Сообщение отредактировал MikeVol - Вторник, 16.04.2024, 17:10
MikeVol, Огромная БАГОДАРНОСТЬ за ответы. Опять я. Можно еще макрос усовершенствовать, что бы он сохранял разрешения для форматирования ячеек, столбцов, строк при повторной защите изначального листа. БЛАГО Дарю.
MikeVol, Огромная БАГОДАРНОСТЬ за ответы. Опять я. Можно еще макрос усовершенствовать, что бы он сохранял разрешения для форматирования ячеек, столбцов, строк при повторной защите изначального листа. БЛАГО Дарю.garbol
garbol, Доброго времени суток. Можно конечно: Вариант #1: Включаете запись макроса (Макрорекордер), делаете все интересующие вас манипуляции с защитой листа (форматирование, выделение защищённых ячеек и т.д.). Останавливаете запись макроса, заходите в редакторVBE и находите записанный вами ваш макрос. Выделяете нужную вам строку и вставляете её (скопированую строку) в блок ActiveSheet.Protect кода моего макроса. Вариант #2: Ищем и учимся по статьям в интернете. К примеру: Вот хорошая статья о Защите Листа И конечно куда же мы без Справки от Microsoft. Думаю вы сами разберётесь с такими пустякам. Удачи.
garbol, Доброго времени суток. Можно конечно: Вариант #1: Включаете запись макроса (Макрорекордер), делаете все интересующие вас манипуляции с защитой листа (форматирование, выделение защищённых ячеек и т.д.). Останавливаете запись макроса, заходите в редакторVBE и находите записанный вами ваш макрос. Выделяете нужную вам строку и вставляете её (скопированую строку) в блок ActiveSheet.Protect кода моего макроса. Вариант #2: Ищем и учимся по статьям в интернете. К примеру: Вот хорошая статья о Защите Листа И конечно куда же мы без Справки от Microsoft. Думаю вы сами разберётесь с такими пустякам. Удачи.MikeVol