Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [Γενικά] Κλειδωμα φυλλων με διαφορετικες επιλογες και κωδικο (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/6111-kleidoma-fyllon-me-diaforetikes-epiloges-kai-kodiko.html)

comsup 06-05-22 17:28

Κλειδωμα φυλλων με διαφορετικες επιλογες και κωδικο
 
Καλησπερα σε ολους! Το προβλημα που αντιμετωπιζω ειναι οτι θελω να κλειδωνω σχεδον ολα τα φυλλα του βιβλιου με τον ιδιο κωδικο, με διαφορετικες επιλογες ομως. Για παραδειγμα σε ενα φυλλο θελω μονο να μπορω νε επιλεγω τα μη κλιδωμενα κελια. Σε αλλο να εποτρεπεται η μορφοποιηση κελιων ή στηλων κλπ.
Αν δεν υπαρχει λυση θα καταφυγω στην μεθοδο ελαχιστου κοινου γκρουπαρισματος επιλογων, δλδ να κλειδωσω ολα τα φυλλα με τις ιδιες επιλογες (οι οποιες θα ειναι αυτες που απαιτει η "χειροτερη" περιπτωση)
Πριν το κανω ετσι ομως σκεφτηκα οτι ισως υπαρχει αλλος καλυτερος τροπος γι αυτο κ δημιουργησα το θεμα στο φορουμ.
Ευχαριστω για το χρονο σας, καλη συνεχεια
Δημητρης

comsup 07-05-22 08:43

Καλημερα, θα ηθελα να απολογηθω για το λαθος μου να αναζητησω βοηθεια χωρις καν να προσπαθησω. Με ψαξιμο και χρησιμοποιωντας κομματια κωδικα που ταιριαζουν εφτιαξα κατι που μου λυνει το προβλημα. Θα ηθελα να το μοιραστω μαζι σας καθως δεν εχω καταφερει ως τωρα να βοηθησω καποιον που αναζητησε βοηθεια. Φυσικα ο κωδικας ισως εχει λαθακια γραψιματος ή θα μπορουσε να απλοποιηθει.
Οι εντολες PROTECT1, PROTECT2, PROTECT3 εγιναν για να κατηγοριοποιησω τα κλειδωματα αναογα με τις επιλογες.

Sub PROTECT1()
'NO SELECTION
Sheets("MENU").Protect Password:="233"
Sheets("LANGUAGES").Protect Password:="233"
End Sub
Sub PROTECT2()
'NO SELECTION NO LOCKED CELLS
Sheets("EVALUATION1").Protect Password:="233"
Sheets("EVALUATION1").EnableSelection = xlUnlockedCells
Sheets("PRESENCES").Protect Password:="233"
Sheets("PRESENCES").EnableSelection = xlUnlockedCells
Sheets("COMPARE").Protect Password:="233"
Sheets("COMPARE").EnableSelection = xlUnlockedCells
Sheets("MATCH SQUAD").Protect Password:="233"
Sheets("MATCH SQUAD").EnableSelection = xlUnlockedCells
Sheets("GK").Protect Password:="233"
Sheets("GK").EnableSelection = xlUnlockedCells
Sheets("DF").Protect Password:="233"
Sheets("DF").EnableSelection = xlUnlockedCells
Sheets("MF").Protect Password:="233"
Sheets("MF").EnableSelection = xlUnlockedCells
Sheets("AT").Protect Password:="233"
Sheets("AT").EnableSelection = xlUnlockedCells
End Sub
Sub PROTECT3()
'SELECT FORMAT CELLS, ROWS, COLUMNS,EDIT OBJ
Sheets("EVALUATION").Protect Password:="233", _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Sheets("EVALUATION2").Protect Password:="233", _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Sheets("EVALUATION3").Protect Password:="233", _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Sheets("TESTS").Protect Password:="233", _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Sheets("FULL ROSTER STATS").Protect Password:="233", _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Sheets("PROGRESS").Protect Password:="233", _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Sheets("SETPIECES").Protect Password:="233", _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End Sub
Sub PROTECTALL()
PROTECT1
PROTECT2
PROTECT3
End Sub
Sub UNPROTECTALL()
'NO SELECTION
Dim PW As Variant
PW = InputBox("ENTER PASSWORD TO UNLOCK :")
On Error Resume Next

Dim ws As Worksheet
'Loop through each worksheet in the active workbook
For Each ws In ActiveWorkbook.Worksheets
'Unprotect each worksheet
ws.Unprotect Password:=PW
Next ws

If Err.Number <> 0 Then
MsgBox "The Password Provided is incorrect"
Exit Sub
End If
On Error GoTo 0
End Sub

christakos 07-05-22 15:40

Καλησπέρα.....

Πιστεύω αν ανεβάσετε ένα δείγμα αρχείου ώστε να διευκολύνετε καλύτερα αυτόν που ίσως να είναι εφικτό να σας βοηθήσουν:dft012:


Η ώρα είναι 08:22.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2