Volgorde van VBA

[Jatto]

Ik gebruik de volgende code in een bestand om de beveiliging op te heffen (workbook open)

Sheets("januari").Range("a100") = Application.UserName   'usernaam zoeken
If Application.UserName = "XXXX" Then
    Sheets("januari").Select
     ActiveSheet.Unprotect Password:="???"

en de volgende code om de voorwaardelijke opmaak van de cel te bepalen

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

 For Each c In Range("b3:af46")
     Select Case c.Value
       Case "V", "v"
            c.Interior.ColorIndex = 24
        Case "c", "C"
            c.Interior.ColorIndex = 34
        Case "W", "w"
            c.Interior.ColorIndex = 15
        Case "P", "p"
            c.Interior.ColorIndex = 19
        Case "z", "Z"
            c.Interior.ColorIndex = 28
       Case "o", "O", "-"
            c.Interior.ColorIndex = 2
       End Select
  Next c
End Sub

Bij het openen van het bestand krijg ik een foutmelding omdat "beveiliging opheffen" nog niet klaar is en daarom de "voorwaardelijke opmaak" niet kan worden uitgevoerd.
Is het mogelijk om de code van de "voorwaardelijke opmaak" pas te laten uitvoeren nadat de beveiliging is verwijderd?

 

[VenA]

Heeft niets met elkaar te maken. Je probeert eerst wat te schrijven in de tab 'januari' en even later ga je de beveiliging er pas afhalen.

 

[Jatto]

Logisch, stom van me. Thx voor de tip

 

[VenA]

Werkt zoiets niet wat beter zonder bij elke wijziging de hele opmaak door te rekenen?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Intersect(Target, Range("B3:AF46")) Is Nothing Then Exit Sub
  ar = Array("v", "c", "w", "p", "z", "o", "-", "", 24, 34, 15, 19, 28, vbnothing, vbnothing, vbnothing)
  On Error GoTo fout
  Target.Interior.ColorIndex = Application.Index(ar, Application.Match(LCase(Target.Value), ar, 0) + 8)
  Exit Sub
fout:
  MsgBox "deze waarde is niet ok."
  Application.Undo
End Sub

En als je gebruik maakt van gegevensvalidatie kan de foutafhandeling er ook nog uit.

 

[HSV]

@VenA, zet de code eens met option explicit.

'vbnothing' is geen onderdeel en zou 'xlnone' moeten zijn, en "" in de array moet vbEmpty zijn.

Dit lijkt me eenvoudiger te begrijpen en geen foutafhandeling nodig.

option explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Not Intersect(Target, Range("B3:AF46")) Is Nothing Then
  With Target
    .Interior.ColorIndex = Switch(LCase(.Value) = "v", 24, LCase(.Value) = "c", 34, LCase(.Value) = "w", 15, LCase(.Value) = "p", 19, LCase(.Value) = "z", 28, .Value = "-", 2, LCase(.Value) = "o", 2)
  End With
 End If
End Sub

Op jouw manier zou ik het zo schrijven.

option explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ar
Application.EnableEvents = False
  If Intersect(Target, Range("B3:AF46")) Is Nothing Then Exit Sub
  ar = Array("v", "c", "w", "p", "z", "o", "-", vbEmpty, 24, 34, 15, 19, 28, xlNone, xlNone, xlNone)
  On Error GoTo fout
  Target.Interior.ColorIndex = ar(Application.Match(Target.Value, ar, 0) + 7)
   Application.EnableEvents = True
   Exit Sub
fout:
  MsgBox "deze waarde is niet ok."
  Application.Undo
  Application.EnableEvents = True
End Sub