Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 75916 Skopiuj do schowka Skoroszyt ochrona wszystkich arkuszy.
Autor Wiadomość
Raazor 
ExcelGaduła 500+


Wersja: Win Office 2016
Posty: 740
Wysłany: 13-06-2024, 23: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 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3468 razy
Posty: 10236
Wysłany: 13-06-2024, 23:59   

Trzeba dopisać parametr
Kod:
Password:="1234"
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 Skopiuj do schowka
 
 
Raazor 
ExcelGaduła 500+


Wersja: Win Office 2016
Posty: 740
Wysłany: 14-06-2024, 10: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 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3468 razy
Posty: 10236
Wysłany: 14-06-2024, 11: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 Skopiuj do schowka
 
 
Raazor 
ExcelGaduła 500+


Wersja: Win Office 2016
Posty: 740
Wysłany: 14-06-2024, 12: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 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2021
Pomógł: 2638 razy
Posty: 8805
Wysłany: 14-06-2024, 13:04   

Poczytaj https://www.excelforum.pl...erinterfaceonly i zaadoptuj.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

FB
ID posta: 435839 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3468 razy
Posty: 10236
Wysłany: 14-06-2024, 14: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 Skopiuj do schowka
 
 
Raazor 
ExcelGaduła 500+


Wersja: Win Office 2016
Posty: 740
Wysłany: 14-06-2024, 18: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 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3468 razy
Posty: 10236
Wysłany: 14-06-2024, 19: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 Skopiuj do schowka
 
 
Raazor 
ExcelGaduła 500+


Wersja: Win Office 2016
Posty: 740
Wysłany: 14-06-2024, 20: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 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3468 razy
Posty: 10236
Wysłany: 14-06-2024, 21: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 Skopiuj do schowka
 
 
Raazor 
ExcelGaduła 500+


Wersja: Win Office 2016
Posty: 740
Wysłany: 14-06-2024, 22:44   

Dziękuję bardzo, potestuję, zobaczymy co mi z tego wyjdzie.
_________________
Raazor
ID posta: 435858 Skopiuj do schowka
 
 
Raazor 
ExcelGaduła 500+


Wersja: Win Office 2016
Posty: 740
Wysłany: 15-06-2024, 13: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 Skopiuj do schowka
 
 
Tajan


Pomógł: 5480 razy
Posty: 11920
Wysłany: 15-06-2024, 14:57   

Jaki jest opis błędu?
ID posta: 435864 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3468 razy
Posty: 10236
Wysłany: 15-06-2024, 14: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 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
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

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.wip.pl

Archiwum

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