Blad beveiliging vinkje objecten bewerken gaat weg

[ozzyozzy]

hoi Allemaal,

ik heb de voglende code voor macro om bladbeveiliging in een keer te activeren. werkt prima, maar na activeren gaat het vinkje bij ''objecten bewerken'' weg. is dit op te lossen?

bedankt.





Voor Beveiliging blad

Sub Macro19(control As IRibbonControl)
    Const PWORD As String = "test1"
    Dim response As String
    Dim msg As String
    msg = "Voer wachtwoord in:"
    
    While response <> PWORD
        response = Application.InputBox(Prompt:=msg, Title:="Password", Type:=2)
        Select Case response
            Case CStr(False)
                Exit Sub 'Cancelled
            Case Else
                msg = "Incorrect!" & vbNewLine & "Voer opnieuw wachtwoord in:"
        End Select
    Wend

'Voer code in
Call werkbladenbeveiligen

End Sub

Sub werkbladenbeveiligen()
Dim blad As Worksheet
For Each blad In ActiveWorkbook.Sheets
    If (blad.ProtectionMode = True) Then
        blad.Protect password:="test", UserInterfaceOnly:=False
        blad.Unprotect password:="test"
    Else
        blad.Protect password:="test", UserInterfaceOnly:=True
    End If
Next blad

 

[JEC.]

Zo misschien?

Sub werkbladenbeveiligen()
Dim blad As Worksheet
For Each blad In ActiveWorkbook.Sheets
    If (blad.ProtectionMode = True) Then
        blad.Protect Password:="test", DrawingObjects:=False, Contents:=True, Scenarios:=True, UserInterfaceOnly:=False
        blad.Unprotect Password:="test"
    Else
        blad.Protect Password:="test", DrawingObjects:=False, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
    End If
Next blad
End Sub

 

[ozzyozzy]

werkt prima tnxx.

 

[ozzyozzy]

ik heb een object in mijn excel bestand. Alleen deze moet beveiligd blijven is dat mogelijk?

Sub werk()
with Worksheet (''planning 1''). Shape (''Afbeelding 1'') 
.visible = Not .Visible 

End Sub

 

[JEC.]

Hier een voorbeeld op tabblad 2. Run de macro in de VBA editor

 

[HSV]

JV,
Niet menen dat for each cell in UseRange alleen de twee cellen beslaat die in het bestand staan.
UsedRange = Range("c12:I13")

sheets(2).usedrange.locked = false

 

[JEC.]

Ik ben ervan uitgegaan dat het bestand van TS er anders uitzag met veel meer cell bezetting. Vandaar de usedrange

 

[ozzyozzy]

Ik krijg een foutmelding op het stukje

cell.Locked = False

Waar kan het aan liggen? enige idee

Sub j()
For Each cell In Sheets(2).UsedRange
 cell.Locked = False
Next
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End Sub

 

[HSV]

Haal de beveiliging er eerst af.

 

[ozzyozzy]

krijg foutmelding met de codes in het excelbestand. Iemand Enige idee hoe op te lossen?
Commandbutton1 werkt niet. tijdens click. maar via sub/userform uitvoeren (F5) heb ik getetst en werkt niet optimaal.

 

[HSV]

Nogal wiedes.

Er is geen code voor CommandButton1.
En als die er al was is het CommandButton3 ipv 1.

 

[ozzyozzy]

Commandbutton is 3 klopt ook. Naam is 1 sorry. De code geeft fout melding voor rechthoek. Object Moet aller tijde beveiligd blijven.

 

[HSV]

Je wilt dus voorkomen dat het wordt verborgen.

Ipv.
.visible = not visible

Wanneer wel, en wanneer niet.

 

[ozzyozzy]

Nee dat is prima. Probleem is als er beveiliging erop zit moet alleen object Rechthoek beveiligd blijven de rest van cellen moeten open blijven ivm opmerkingen invoegen/ wijzigen in cellen.
Zie boven werkbeveiliging. En shape

 

[JEC.]

Haal eerst het wachtwoord overal vanaf voordat je de code runt

 

[ozzyozzy]

Ik heb nog steeds een probleem met volgorde en foutmelding object beveiligen plaatje. module 2. en blad1.
Na beveiligen van het document.
cellen bewerkbaar A16:J17
opmerking toevoegen (object): moet de cellen open blijven A16:J17
Plaatje object beveiligd.



bedankt.