Foutmelding uitschakelen bij beveiligde cellen

[robinvdveeken]

Beste Forumleden,

Ik ben een formulier aan het maken waarbij bepaalde cellen beveiligd moeten worden.
Dit is gelukt. Het is nu zo dat als je dubbel klinkt op een beveiligde cel er een foutmelding komt. Kan je dit uitschakelen?
Het komt zo onvriendelijk over...
Alvast bedankt!

Groeten,
Robin

 

[Warme bakkertje]

Sub Workbook_open()
    With Sheets("Blad1")
        .Protect
        .EnableSelection = xlUnlockedCells
    End With
End Sub

 

[robinvdveeken]

Ongetwijfeld zal ik iets niet goed doen..
Maar wat?
Alvast bedankt!

De achterliggende bladen heb ik verwijderd ivm de grote.

 

[robinvdveeken]

Hier een voorbeeld van hoe de opmaak er ongeveer uit moet gaan zien...
Ja kan wijzigen wat nodig is, en de rest is er simpelweg niet.
Ook geen werkbalken etc.

Dit bestand is beveiligd dus ik kan de truc niet afkijken..

 

[Warme bakkertje]

Zet deze eens net onder je Dim-Statements

On Error GoTo Einde

En deze net boven End sub

Einde:

 

[robinvdveeken]

Rudi, bedankt voor je reactie
Het heeft nog niet het gewenste resultaat.

De code ziet er nu zo uit:

 Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rij As Integer, Kolom As Integer, Cel As Range
  Dim DoelCellen As Range
  Dim EindRij As Integer, EindKolom As Integer, TekstB As String, TekstC As String
  On Error GoTo Einde
  EindRij = Sheets("Blad1").UsedRange.Rows.Count
  EindKolom = Sheets("Blad1").UsedRange.Columns.Count - 1
  Set DoelCellen = Cells(1, 100)
  For Kolom = 6 To EindKolom Step 3
    Set DoelCellen = Union(DoelCellen, Range(Cells(98, Kolom), Cells(EindRij, Kolom)))
  Next Kolom
  Set DoelCellen = DoelCellen.SpecialCells(xlCellTypeConstants)
  For Each Cel In DoelCellen
    If Rows(Cel.Row).Hidden = False Then
      Rij = Cel.Row
      TekstB = LCase(Cells(Rij, 2)): TekstC = LCase(Cells(Rij, 3))
      If Cel.Offset(0, -1) = "<>" Then
               
      
      Rows(Cel.Offset(0, 1).Value).Hidden = LCase(Cel) <> TekstB And LCase(Cel) <> TekstC
      Else
        Rows(Cel.Offset(0, 1).Value).Hidden = (LCase(Cel) = TekstB Or LCase(Cel) = TekstC)
      End If
    End If
  Next Cel
Einde:
End Sub

Sub Workbook_open()
    With Sheets("Blad1")
        .Protect
        .EnableSelection = xlUnlockedCells
    End With

End Sub

 

[Warme bakkertje]

De eerste code die ik je gegeven heb mag je wissen want deze is hier niet van toepasssing aangezien de foutmelding voortkomt uit de gebruikte macro en niet van het selecteren van geblokkeerde cellen. (of misschien de combinatie van je macro en het beveiligen van je werkblad)maar dat moet ik nog even bekijken.

 

[robinvdveeken]

Zonder het blad te beveiligen, en zonder de code die je gaf komt er geen foutmelding.
Ik denk dat de clue zit in het verbergen en tonen van cellen.
Het is de bedoeling dat afhankelijk van de keuzes rijen verborgen en/of getoond worden. Dit gaat prima met de huidige code. Het zou mooi zijn als er ook niet ingevuld kan worden bij een aantal cellen.

 

[ExcelAmateur]

robinvdveeken,

Ik weet er ook niet veel van maar dit stukje code,

Sub Workbook_open()
    With Sheets("Blad1")
        .Protect
        .EnableSelection = xlUnlockedCells
    End With
End Sub

Hoort in ThisWorkbook te staan.

 

[robinvdveeken]

Bedankt voor de reactie.

In de bijlage het flink ingekorte bestand met daarin de suggestie van ExcelAmateur.
Deze geeft een foutmelding in VB.
Verder heb ik eerst alle cellen geblokkeerd en daarna van de cellen welke gewijzigd moeten kunnen worden de blokkering opgeheven.

Iemand suggesties?

Groeten,
Robin

 

[robinvdveeken]

De bijlage

 

[robinvdveeken]

K zag zojuist de belabberde kwaliteit van mijn voorbeeldbijlage.
Ik heb even een printscreen gemaakt van het bestand zoals ik het ongeveer voor ogen heb. Deze is beveiligd

 

[ExcelAmateur]

Je moet in het begin en op het einde van je code;

Sub Wat()
Application.ScreenUpdating = False
Jouw code
Application.ScreenUpdating = True
end Sub

Dat voorkomt het flikkeren van het scherm.

Zijn de cellen waar de veranderingen van de validatie komen, staan die eigenschappen op niet geblokkeerd?

 

[robinvdveeken]

Bedankt voor de suggestie!
Dat zou betekenen dat de Subs die ik nu heb binnen een de Sub jij geeft zou komen?
Op deze manier:

Sub Wat()
Application.ScreenUpdating = False
 
 Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Rij As Integer, Kolom As Integer, Cel As Range
  Dim DoelCellen As Range
  Dim EindRij As Integer, EindKolom As Integer, TekstB As String, TekstC As String
  
  EindRij = Sheets("Blad1").UsedRange.Rows.Count
  EindKolom = Sheets("Blad1").UsedRange.Columns.Count - 1
  Set DoelCellen = Cells(1, 100)
  For Kolom = 6 To EindKolom Step 3
    Set DoelCellen = Union(DoelCellen, Range(Cells(98, Kolom), Cells(EindRij, Kolom)))
  Next Kolom
  Set DoelCellen = DoelCellen.SpecialCells(xlCellTypeConstants)
  For Each Cel In DoelCellen
    If Rows(Cel.Row).Hidden = False Then
      Rij = Cel.Row
      TekstB = LCase(Cells(Rij, 2)): TekstC = LCase(Cells(Rij, 3))
      If Cel.Offset(0, -1) = "<>" Then
               
      
      Rows(Cel.Offset(0, 1).Value).Hidden = LCase(Cel) <> TekstB And LCase(Cel) <> TekstC
      Else
        Rows(Cel.Offset(0, 1).Value).Hidden = (LCase(Cel) = TekstB Or LCase(Cel) = TekstC)
      End If
    End If
  Next Cel

End Sub

Application.ScreenUpdating = True
End Sub

Over de blokkering, de cellen die niet gewijzigd mogen worden staan op geblokkeerd. De cellen welke wel gewijzigd mogen worden, dus ook de validatiecellen staan niet geblokkeerd.

 

[robinvdveeken]

Dit geeft een foutmelding.
Ik heb de code aangepast tot het volgende:

 Private Sub Worksheet_Change(ByVal Target As Range)
 Application.ScreenUpdating = False
  Dim Rij As Integer, Kolom As Integer, Cel As Range
  Dim DoelCellen As Range
  Dim EindRij As Integer, EindKolom As Integer, TekstB As String, TekstC As String
  
  EindRij = Sheets("Blad1").UsedRange.Rows.Count
  EindKolom = Sheets("Blad1").UsedRange.Columns.Count - 1
  Set DoelCellen = Cells(1, 100)
  For Kolom = 6 To EindKolom Step 3
    Set DoelCellen = Union(DoelCellen, Range(Cells(98, Kolom), Cells(EindRij, Kolom)))
  Next Kolom
  Set DoelCellen = DoelCellen.SpecialCells(xlCellTypeConstants)
  For Each Cel In DoelCellen
    If Rows(Cel.Row).Hidden = False Then
      Rij = Cel.Row
      TekstB = LCase(Cells(Rij, 2)): TekstC = LCase(Cells(Rij, 3))
      If Cel.Offset(0, -1) = "<>" Then
               
      
      Rows(Cel.Offset(0, 1).Value).Hidden = LCase(Cel) <> TekstB And LCase(Cel) <> TekstC
      Else
        Rows(Cel.Offset(0, 1).Value).Hidden = (LCase(Cel) = TekstB Or LCase(Cel) = TekstC)
      End If
    End If
  Next Cel

Application.ScreenUpdating = True
End Sub

Dit werkt super!

Maar nog geen beveiligde cellen..

 

[robinvdveeken]

Is er misschien nog iemand anders die weet hoe je:

- Een deel van de cellen tegen schrijven kan beveiligen
- Wel cellen kan verbergen (aan de hand van bovenstaande code).
- Geen foutmelding wanneer er toch getracht word een cel aan te passen.

Alvast bedankt

Groeten,
Robin