Во вложении файл с макросом на открытие книги. Код:
[vba]
Код
Private Sub Workbook_Open() Application.ScreenUpdating = False Dim wsSh As Object For Each wsSh In Me.Sheets If wsSh.Name = "Прочее" Then GoTo b If wsSh.Name = "Цель кредита" Then GoTo b wsSh.EnableOutlining = True If wsSh.Name = "Консолидация" Then GoTo a wsSh.Protect Password:="0000", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserinterfaceOnly:=True, AllowFormattingRows:=True, AllowFiltering:=True GoTo b a: wsSh.Protect Password:="0000", DrawingObjects:=False, Contents:=True, Scenarios:=True, UserinterfaceOnly:=True, AllowFormattingRows:=True, AllowAutoFiltering:=True b: Next wsSh Application.ScreenUpdating = True Application.CellDragAndDrop = False End Sub
[/vba]
Выдаёт ошибку 1004 на строке после a:
Подскажите, пожалуйста, в чём причина. Задача: заблокировать все листы кроме двух, а на одном из заблокированных оставить возможность редактирования объектов
Во вложении файл с макросом на открытие книги. Код:
[vba]
Код
Private Sub Workbook_Open() Application.ScreenUpdating = False Dim wsSh As Object For Each wsSh In Me.Sheets If wsSh.Name = "Прочее" Then GoTo b If wsSh.Name = "Цель кредита" Then GoTo b wsSh.EnableOutlining = True If wsSh.Name = "Консолидация" Then GoTo a wsSh.Protect Password:="0000", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserinterfaceOnly:=True, AllowFormattingRows:=True, AllowFiltering:=True GoTo b a: wsSh.Protect Password:="0000", DrawingObjects:=False, Contents:=True, Scenarios:=True, UserinterfaceOnly:=True, AllowFormattingRows:=True, AllowAutoFiltering:=True b: Next wsSh Application.ScreenUpdating = True Application.CellDragAndDrop = False End Sub
[/vba]
Выдаёт ошибку 1004 на строке после a:
Подскажите, пожалуйста, в чём причина. Задача: заблокировать все листы кроме двух, а на одном из заблокированных оставить возможность редактирования объектовAlmost
Private Sub Workbook_Open() Application.ScreenUpdating = False Dim wsSh As Worksheet For Each wsSh In Me.Sheets If wsSh.Name <> "Прочее" And wsSh.Name <> "Цель кредита" Then wsSh.EnableOutlining = True DO_ = True If wsSh.Name = "Консолидация" Then DO_ = False wsSh.Protect Password:="0000", DrawingObjects:=DO_, Contents:=True, Scenarios:=True, UserinterfaceOnly:=True, AllowFormattingRows:=True, AllowFiltering:=True End If Next wsSh Application.ScreenUpdating = True Application.CellDragAndDrop = False End Sub
[/vba] На всякий случай (вдруг кто не в курсе) предупрежу, что последняя строчка макроса отключает маркер заполнения/перетаскивания. Кто уже запустил макрос из первого поста - запустите отдельно вот это и все станет на место [vba]
Код
Application.CellDragAndDrop = True
[/vba] Да, и действительно - Worksheet. Поправил у себя, сразу не заметил.
Goto - это не по феншую. Попробуйте вот так [vba]
Код
Private Sub Workbook_Open() Application.ScreenUpdating = False Dim wsSh As Worksheet For Each wsSh In Me.Sheets If wsSh.Name <> "Прочее" And wsSh.Name <> "Цель кредита" Then wsSh.EnableOutlining = True DO_ = True If wsSh.Name = "Консолидация" Then DO_ = False wsSh.Protect Password:="0000", DrawingObjects:=DO_, Contents:=True, Scenarios:=True, UserinterfaceOnly:=True, AllowFormattingRows:=True, AllowFiltering:=True End If Next wsSh Application.ScreenUpdating = True Application.CellDragAndDrop = False End Sub
[/vba] На всякий случай (вдруг кто не в курсе) предупрежу, что последняя строчка макроса отключает маркер заполнения/перетаскивания. Кто уже запустил макрос из первого поста - запустите отдельно вот это и все станет на место [vba]
Код
Application.CellDragAndDrop = True
[/vba] Да, и действительно - Worksheet. Поправил у себя, сразу не заметил._Boroda_