ID tematu: 75916
 |
Skoroszyt ochrona wszystkich arkuszy. |
Autor |
Wiadomość |
Raazor
ExcelGaduła 500+

Wersja: Win Office 2016
Posty: 785
|
Wysłany: 13-06-2024, 22:45 Skoroszyt ochrona wszystkich arkuszy.
|
|
|
W skoroszycie znajduje się poniższe makro chroniące wszystkie arkusze. Ochrona nie ma hasła.
Jak przerobić kod, aby dodać hasło przy zdejmowaniu ochrony, np. 1234.
Kod: | Private Sub Workbook_Open()
Dim wrksht As Worksheet
For Each wrksht In ThisWorkbook.Worksheets
wrksht.Protect DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False, _
UserInterfaceOnly:=True
Next
End Sub |
Z góry dziękuję za pomoc. |
_________________ Raazor |
|
 | ID posta:
435826
|
|
|
 |
|
|
|
Maciej Gonet
Excel Expert

Wersja: Win Office 365
Pomógł: 3568 razy Posty: 10515
|
Wysłany: 13-06-2024, 22:59
|
|
|
Trzeba dopisać parametr
Zwykle podaje się go jako pierwszy, ale gdy jest podana nazwa parametru, to kolejność nie ma znaczenia.
Kod: | For Each wrksht In ThisWorkbook.Worksheets
wrksht.Protect Password:="1234", _
DrawingObjects:=False, _
Contents:=True, _
' ... |
|
|
 | ID posta:
435827
|
|
|
 |
|
|
Raazor
ExcelGaduła 500+

Wersja: Win Office 2016
Posty: 785
|
Wysłany: 14-06-2024, 09:28
|
|
|
Testuję.
Po wstawieniu poprawionego kodu z dodanym parametrem:
Kod: | Private Sub Workbook_Open()
Dim wrksht As Worksheet
For Each wrksht In ThisWorkbook.Worksheets
wrksht.Protect Password:="1234", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False, _
UserInterfaceOnly:=True
Next
End Sub |
zauważyłem, że po otwarciu skoroszytu coś długo się on uruchamia. Około 10 sekund na arkuszu kręci się kółeczko zanim wszystko się unormuje. Zabezpiecza wskazanym hasłem.
Skoroszyt z makrem bez wstawionego parametru z hasłem, otwiera się natychmiast, nic się nie dzieje i nie kręci. Nie wiem co jest tego przyczyną. |
_________________ Raazor |
|
 | ID posta:
435830
|
|
|
 |
|
|
Maciej Gonet
Excel Expert

Wersja: Win Office 365
Pomógł: 3568 razy Posty: 10515
|
Wysłany: 14-06-2024, 10:58
|
|
|
Ja również nie wiem. Trzeba poeksperymentować. Ja sprawdzałem na skoroszycie z 3 arkuszami, prawie pustymi. I działało sprawnie.
Nie wiem, ile masz arkuszy i czym są wypełnione.
Ponadto, wykonujesz tę procedurę ochrony przy otwieraniu skoroszytu. Jeśli to nie jest pierwsze wykonanie, to arkusze powinny być cały czas chronione, więc można sprawdzać przy otwieraniu, czy arkusz jest chroniony i jeśli jest, pominąć nakładanie ochrony. Może to coś przyspieszy.
Sprawdź.
Kod: | Private Sub Workbook_Open()
Dim wrksht As Worksheet
For Each wrksht In ThisWorkbook.Worksheets
If Not wrksht.ProtectContents Then
wrksht.Protect Password:="1234", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False, _
UserInterfaceOnly:=True
End If
Next
End Sub
|
|
|
 | ID posta:
435835
|
|
|
 |
|
|
Raazor
ExcelGaduła 500+

Wersja: Win Office 2016
Posty: 785
|
Wysłany: 14-06-2024, 11:46
|
|
|
Super, teraz skoroszyt otwiera się bezproblemowo. Chcę dodać, że w skoroszycie znajduje się ponad 50 arkuszy, które zabezpieczone są hasłem podanym w makrze.
Jednak jak zwykle podczas testów zawsze pojawi się jakiś krzak.
W niektórych arkuszach znajdują się przyciski np.: Wyczyść
Kod: | Sub Wyczysc_DX_Tabela()
Range("B2,C2,D4:D12,H4:H8").ClearContents
End Sub |
Lub: Sortuj
Kod: | Sub Sortuj_Sieć_Dziennik()
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets("Sieć Teletrans Dziennik")
.AutoFilterMode = False
.Range("B5:O5").AutoFilter
.AutoFilter.Sort.SortFields.Clear
.AutoFilter.Sort.SortFields.Add Key:=.Range("L5"), SortOn:=xlSortOnValues, Order:=xlAscending
With .AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub |
Kiedy klikam w przycisk, Wyczyść lub Sortuj nie można nic zrobić z uwagi na ochronę arkusza.
Czy można coś zmienić w parametrach głównego kodu:
Kod: | Private Sub Workbook_Open()
Dim wrksht As Worksheet
For Each wrksht In ThisWorkbook.Worksheets
If Not wrksht.ProtectContents Then
wrksht.Protect Password:="1234", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False, _
UserInterfaceOnly:=True
End If
Next
End Sub |
Aby można było korzystać z przycisków do np. Sortowania i czyszczenia. |
_________________ Raazor |
|
 | ID posta:
435838
|
|
|
 |
|
|
Marecki
Excel Expert


Wersja: Win Office 2021
Pomógł: 2642 razy Posty: 8821
|
|
 | ID posta:
435839
|
|
|
 |
|
|
Maciej Gonet
Excel Expert

Wersja: Win Office 365
Pomógł: 3568 razy Posty: 10515
|
Wysłany: 14-06-2024, 13:15
|
|
|
Prawdopodobnie przy zamykaniu i ponownym otwieraniu skoroszytu gubi się wartość 'UserInterfaceOnly:=True'
Można spróbować tak:
Kod: | Private Sub Workbook_Open()
Dim wrksht As Worksheet
For Each wrksht In ThisWorkbook.Worksheets
If Not wrksht.ProtectContents Then
wrksht.Protect Password:="1234", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False, _
UserInterfaceOnly:=True
Else
wrksht.Protect Password:="1234", _
UserInterfaceOnly:=True
End If
Next
End Sub
| ale to może znowu działać wolniej.
Alternatywą jest zdejmowanie ochrony przed każdą taką procedurą, którą chcesz wykonywać i ponowne jej zakładanie po zakończeniu.
To już musisz sam ocenić, co jest dla Ciebie korzystniejsze - nie wiem ile masz takich procedur, które chcesz uruchamiać w chronionych arkuszach. |
|
 | ID posta:
435845
|
|
|
 |
|
|
Raazor
ExcelGaduła 500+

Wersja: Win Office 2016
Posty: 785
|
Wysłany: 14-06-2024, 17:04
|
|
|
Wstawiłem powyższy kod do mojego skoroszytu, jednak muli, długo się otwiera skoroszyt, tak jak przy poprzednim makrze.
Może tu da się coś zrobić.
Testowałem taki krótki kod, pozbywając się wielu parametrów. Ten Zabezpiecza hasłem oraz pokazuje belkę formatowania. Jest ok., nie ma problemu z uruchomieniem.
Kod: | Private Sub Workbook_Open()
Dim wrksht As Worksheet
For Each wrksht In ThisWorkbook.Worksheets
wrksht.Protect Password:="1234", AllowFormattingCells:=True
Next
End Sub
|
Jednak tutaj nie mogę uruchomić kodu pod przyciskiem:
Kod: | Sub Wyczysc_DX_Tabela()
Range("B2,C2,D4:D12,H4:H8").ClearContents
End Sub |
Z innymi przyciskami poradzę sobie zdejmując ochronę. Jednak arkusz w którym znajduje się przycisk Wyczyść, musi być chroniony, z uwagi na to, że korzystają z niego inne osoby, zdejmują ochronę i nawet nieświadomie kasują znajdujące się tam formuły. |
_________________ Raazor |
|
 | ID posta:
435850
|
|
|
 |
|
|
Maciej Gonet
Excel Expert

Wersja: Win Office 365
Pomógł: 3568 razy Posty: 10515
|
Wysłany: 14-06-2024, 18:38
|
|
|
Przecież chodzi o to, żeby zdjąć ochronę tylko na chwilę, na czas wykonywania operacji i zaraz potem ją przywrócić. W tym czasie nikt niczego nie zdąży namieszać.
Kod: | Sub Wyczysc_DX_Tabela()
ActiveSheet.Unprotect Password:="1234"
Range("B2,C2,D4:D12,H4:H8").ClearContents
ActiveSheet.Protect Password:="1234"
End Sub |
|
|
 | ID posta:
435851
|
|
|
 |
|
|
Raazor
ExcelGaduła 500+

Wersja: Win Office 2016
Posty: 785
|
Wysłany: 14-06-2024, 19:52
|
|
|
Zastosowałem takie makro.
Kod: | Private Sub Workbook_Open()
Dim wks As Worksheet
Dim WksA As Worksheet
Set WksA = ActiveSheet
'...
For Each wks In ThisWorkbook.Worksheets
If wks.Name = "Wykaz" Or _
wks.Name = "Plan Urlopów" Or _
wks.Name = "Wykaz telefonów" Or _
wks.Name = "Telefony Baza" Or _
wks.Name = "Urlop-24" Then
wks.Protect Password:="1234", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False, _
UserInterfaceOnly:=True
End If
Next
'....
WksA.Activate
End Sub |
Testuję.
Jak na razie jest ok. Dobrze się uruchamia. Wymienione w parametrach nazwy arkuszy są automatycznie chronione po zamknięciu skoroszytu. Przyciski makra działają. Zobaczę czy się coś nie wykrzaczy. |
_________________ Raazor |
|
 | ID posta:
435855
|
|
|
 |
|
|
Maciej Gonet
Excel Expert

Wersja: Win Office 365
Pomógł: 3568 razy Posty: 10515
|
Wysłany: 14-06-2024, 20:08
|
|
|
Jeśli arkuszy jest 50, a chronić trzeba tylko 5, to można to zapisać np. tak:
Kod: | For Each wks In ThisWorkbook.Worksheets(Array("Wykaz", "Plan Urlopów", _
"Wykaz telefonów", "Telefony Baza", "Urlop-24"))
|
|
|
 | ID posta:
435856
|
|
|
 |
|
|
Raazor
ExcelGaduła 500+

Wersja: Win Office 2016
Posty: 785
|
Wysłany: 14-06-2024, 21:44
|
|
|
Dziękuję bardzo, potestuję, zobaczymy co mi z tego wyjdzie. |
_________________ Raazor |
|
 | ID posta:
435858
|
|
|
 |
|
|
Raazor
ExcelGaduła 500+

Wersja: Win Office 2016
Posty: 785
|
Wysłany: 15-06-2024, 12:51
|
|
|
Testuję.
Coś w tym kodzie zrobiłem nie tak. Nie działa mi. Od razu po otwarciu skoroszytu pojawia się błąd.
Kod: | Private Sub Workbook_Open()
Dim wks As Worksheet
Dim WksA As Worksheet
Set WksA = ActiveSheet
'...
For Each wks In ThisWorkbook.Worksheets(Array("Wykaz", "Plan Urlopów", _
"Wykaz Telefonów", "Telefony Baza", "Urlop-24"))
wks.Protect Password:="1234", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False, _
UserInterfaceOnly:=True
End If
Next
'....
WksA.Activate
End Sub
|
|
_________________ Raazor |
|
 | ID posta:
435862
|
|
|
 |
|
|
Tajan

Pomógł: 5583 razy Posty: 12105
|
Wysłany: 15-06-2024, 13:57
|
|
|
Jaki jest opis błędu? |
|
 | ID posta:
435864
|
|
|
 |
|
|
Maciej Gonet
Excel Expert

Wersja: Win Office 365
Pomógł: 3568 razy Posty: 10515
|
Wysłany: 15-06-2024, 13:58
|
|
|
Jaki błąd? Zawsze trzeba dokładnie opisać. Ja tu widzę niepotrzebne 'End If', które zostało po poprzedniej wersji. |
|
 | ID posta:
435865
|
|
|
 |
|
|
|
Nie możesz pisać nowych tematów Nie możesz odpowiadać w tematach Nie możesz zmieniać swoich postów Nie możesz usuwać swoich postów Nie możesz głosować w ankietach Nie możesz załączać plików na tym forum Możesz ściągać załączniki na tym forum
|
Dodaj temat do Ulubionych Wersja do druku
|
|
Strona uĹźywa plikĂłw cookies.
Kliknij tutaj, Ĺźeby dowiedzieÄ siÄ jaki jest cel uĹźywania cookies oraz jak zmieniÄ ustawienia cookie w przeglďż˝darce.
KorzystajÄ
c ze strony uĹźytkownik wyraĹźa zgodÄ na uĹźywanie plikĂłw cookies, zgodnie z bieĹźÄ
cymi ustawieniami przeglÄ
darki.
SprawdĹş, w jaki sposĂłb przetwarzamy dane osobowe
|