Mogeljikheid om wijzigen Cell interior toe te staan met de functie Protect??

[robert123321]

Is het mogelijk om het wijzigen van de opvulkleur van een of meerdere cellen toe te staan met het gebruik van de vba functie Protect?

Ik weet dat bij beveiliging -> celeigenschappen de mogelijkheid is. Maar ik wil juist niet dat de gebruikers van het document zelf de beveiliging van het desbetreffende blad gaan aanpassen. Daarom wil ik het blad beveiligen middels een macro met de optie om een opvulkleur toe te laten kennen aan een cel door de gebruiken.

Gr Robert

 

[RoCompy87]

Als je je werkblad op onderstaande manier beveiligd, lukt het wel. Macro's behouden op deze manier als het ware de toegang tot het werkblad.

ActiveSheet.Protect userinterfaceonly:=True

Succes! :thumb:

 

[robert123321]

Met de volgende code is het nog steeds niet mogelijk om op het werkblad met met de colordialog(invulkleur) één of meerdere cellen in te kleuren.

ActiveSheet.Protect userinterfaceonly:=True

Op google kan ik er ook niets over vinden. Ik zit er aan te denken een knop op het blad te plaatsen waarmee de gebruikers de door hun geselecteerde cellen kunnen inkleuren. Helaas is dit niet de mooiste en meest ideale oplossing.

Om iets meer te vertellen over het document: Het blad waar data ingevoerd kan worden is een tijdelijk blad. Men moet hierop kunnen aangeven als iets met voorrang behandeld dient te worden middels een opvulkleur. Het blad verdwijnt weer indien alles is afgehandeld. Indien het blad is afgehandeld wordt er middels een macro een nieuw blad aangemaakt inclusief knop met code. De opmaak van het blad mag absoluut niet veranderd worden omdat dit andere conflict geeft met andere macro's in het document, echter moet de invulkleur van de cellen wel aangepast kunnen worden. Daarom moet het blad (deels) beveiligd zijn.

 

[RoCompy87]

Weet je zeker dat je verwijzingen naar het blad kloppen, aangezien het blad wordt verwijderd en er weer een nieuwe voor terugkomt...

Misschien heb je een voorbeeldbestand waarin de situatie duidelijker wordt? Dan zien we ook de hele code eromheen.

 

[robert123321]

Stukje code

Met de onderstaande code wordt de nieuwe sheet aangemaakt.
Als ik de laatste regel vervang door ....Protect userinterfaceonly:=True werkt het nog steeds niet.

Private Sub NewOVsheet()

Dim WS As Worksheet
Dim WSnew As New Worksheet
Dim Nm As String, BC As String
Dim rng As Range
Dim smpl As Integer
Dim Btn(1) As OLEObject
Dim i As Long


If ListView1.ListItems.Count > 0 Then smpl = 96 - ListView1.SelectedItem.SubItems(1)

Nm = NewPlateNumber

BC = Barcode(Nm)
If BC = "" Then
    ListView1.SetFocus
    Exit Sub
End If

Set WSnew = ActiveWorkbook.Sheets.Add
Set WS = ActiveWorkbook.Sheets("LegeSheet")

With WSnew
    .Name = Nm
    WS.Range("A1:M100").Copy Destination:=.Range("A2")
    WS.Range("A1:M100").Copy Destination:=.Range("J2")
    'forward part
    .Range("A1").Value = Nm & "F"
    .Range("A1").HorizontalAlignment = xlLeft
    .Columns("A:A").ColumnWidth = 12
    .Range("B1").Value = BC
    .Columns("B:B").ColumnWidth = 8.71
    .Range("A1").Interior.ColorIndex = 8
    .Columns("G:G").ColumnWidth = 17.57
    .Columns("D:D").ColumnWidth = 26.86
    .Range("G3:G100").Value = ""
    'reverse part
    .Range("J1").Value = Nm & "R"
    .Range("J1").HorizontalAlignment = xlLeft
    .Columns("J:J").ColumnWidth = 12
    .Range("B1").Value = BC
    .Columns("K:K").ColumnWidth = 8.71
    .Range("J1").Interior.ColorIndex = 8
    .Columns("N:N").ColumnWidth = 17.57
    .Columns("M:M").ColumnWidth = 26.86
    .Range("P3:P100").Value = ""
    .Activate
End With

Set Btn(0) = WSnew.OLEObjects.Add(ClassType:="Forms.Commandbutton.1", Link:=True _
                                , DisplayAsIcon:=False, Left:=475, Top:=0, Width:=77, Height:=33)
Set Btn(1) = WSnew.OLEObjects.Add(ClassType:="Forms.Commandbutton.1", Link:=True _
                                , DisplayAsIcon:=False, Left:=475, Top:=45, Width:=77, Height:=33)

With Btn(0)
    .Name = "btnReady"
    .Object.Caption = "Klaar"
    .Placement = XlPlacement.xlMoveAndSize
End With
With Btn(1)
    .Name = "btnReplace"
    .Object.Caption = "F -> R"
    Placement = XlPlacement.xlMoveAndSize
End With

 
AddButtonCode Nm, "btnReady"
AddButtonCode Nm, "btnReplace"


Set rng = WSnew.Cells.Find(What:="Aanvrager", After:=ActiveCell, LookIn:=xlFormulas, _
                                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                    MatchCase:=False, SearchFormat:=False)

    If Not rng Is Nothing Then
        rng.Activate
        rng.Offset(smpl + 1, 0).Select
    End If

WSnew.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
              , AllowFormattingColumns:=True
              

End Sub

 

[RoCompy87]

Hmm, ik denk dat ik de code niet helemaal begrijp, want...

- er wordt een nieuw werkblad toegevoegd
- dan gebeurt er van alles, waaronder de opvulkleur van de cel wijzigen
- en pas als laatste wordt het nieuwe blad beveiligd

...dus dan kan protect toch niet het probleem zijn? Anders zou onderstaande namelijk gewoon moeten werken volgens mij...

WSnew.Protect Userinterfaceonly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True _
              , AllowFormattingColumns:=True

 

[robert123321]

Werkt niet bij mij.

Ik denk wel dat het probleem wel bij protect ligt. Als ik handmatig de beveiliging verwijder en deze er vervolgens weer op zet met daarbij de optie "celeigenschappen" aangevinkt kan ik wel handmatig de opvulkleur van de cellen wijzigen.

Ik heb het trouwens over Exel 2003. Mischien dat daar het verschilt zit??

 

[RoCompy87]

Het lijkt mij niet dat het komt door Excel 2003. Maar ik moet eerlijk zeggen dat ik je niet meer verder kan helpen. Iemand anders misschien?