Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Ingen ark bortsett frå dette skal ha valideringslister
If Sh.Name = "Registrering" Then
Call deaktiver
Else
Exit Sub
End If
' Ikkje lag lister om det oppstår ein feil (f.eks. om Target.Count er veldig stor)
On Error GoTo errorHandler:
If Target.Count > 1 Then
Call reaktiver
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
' Om det er overskriftskolonna som vert vald skal det heller ikkje lagast lister.
If Target.Row = 1 Then
Call reaktiver
Exit Sub
End If
' Sjekk om det vert registrert riktig!
Select Case Target.Column
Case 1, 9:
If Not Target = "" Then
Call rediger_ark(Sh)
Target = CLng(Target)
Target.NumberFormat = "dd. mmm"
Call lås_ark(Sh)
End If
Case 2, 10:
If Not Target = "" Then
Call rediger_ark(Sh)
Target.NumberFormat = "HH:mm"
Call lås_ark(Sh)
End If
Case 3:
Call hovudlister(Target)
Case 5:
Call detaljertelister(Range(Target.Address(external:=True)))
Case Else:
MsgBox ("Noko gjekk gale i ThisWorkbook når celle " & Target.Address(external:=True) & " vart endra.")
End Select
Call reaktiver
Exit Sub
errorHandler:
If Err.Number = 6 Then
Debug.Print ("Overflow error!")
Call reaktiver
On Error GoTo 0
Exit Sub
Else
Debug.Print ("Feil nummer " + Err.Number + ". Beskrivelse: " + Err.Description + ". Skjøner ikkje korleis me hamna her!")
Resume
End If
End Sub
Sub detaljertelister(endraCelle As Range)
Dim listaStarterICelle As Range, overskrifter As Range
Call rediger_ark(registrering)
' Finn verdien frå cella, ventar med offset i tilfelle nothing.
Set listaStarterICelle = Detaljlister.Rows(1).Find(endraCelle.Offset(0, -2).Value, LookIn:=xlValues, MatchCase:=False)
' Feilsjekk
If listaStarterICelle Is Nothing Then
MsgBox ("Noko gjekk gale - få nokon til å sjå på kva endringar som er gjort i arket i det siste.")
Exit Sub
Else
' Overskrifter = moglege verdiar for den valde utstyrsgruppa.
Set overskrifter = Range(listaStarterICelle, listaStarterICelle.End(xlToRight).Offset(0, -1)).Offset(1, 0)
Debug.Print (overskrifter.Address(external:=True))
End If
Set listaStarterICelle = overskrifter.Find(endraCelle.Value, LookIn:=xlValues, MatchCase:=False)
' Feilsjekk
If listaStarterICelle Is Nothing Then
MsgBox ("Noko gjekk gale - få nokon til å sjå på kva endringar som er gjort i arket i det siste.")
Exit Sub
End If
Set listaStarterICelle = listaStarterICelle.Offset(1, 0)
' Ny validering for detaljårsaker, tid og skift
With endraCelle
Range(.Offset(0, 1), .Offset(0, 5)).Validation.Delete
' Oppdater validering for kolonne F (detaljårsaker)
.Offset(0, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=("=" + lagListe(listaStarterICelle).Address(external:=True))
' Oppdater formel for kolonne E (stanstid)
If IsEmpty(.Offset(0, 2)) Then
.Offset(0, 2).FormulaR1C1 = "=IF(ISBLANK(RC10)," & Chr(34) & Chr(34) & ",ROUND(((INT(RC9)+MOD(RC10,1))-(INT(RC1)+MOD(RC2,1)))*24,0))" ' <------------ HERE'S WHERE THE FORMULA IS GENERATED
End If
With .Offset(0, 3).Validation
.Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1", Formula2:="5"
.ErrorMessage = "Verdien i denne kolonna må vere eit heiltal mellom 1 og 5."
.ErrorTitle = "Feil i inndata."
.InputMessage = "Skriv inn kva skift som var på då stansen skjedde."
.InputTitle = "Skift."
End With
' Lås opp alt bortsett frå kolonne E
.Offset(0, 1).Locked = False
Range(.Offset(0, 3), .Offset(0, 5)).Locked = False
End With
' Dato i kolonne I
With endraCelle.Offset(0, 4).Validation
.Add Type:=xlValidateDate, AlertStyle:=xlValidAlertStop, Operator:=xlGreaterEqual, Formula1:="=" & endraCelle.Offset(0, -4).Address(external:=True)
.ErrorMessage = "Verdien i denne kolonna må vere ein dato større eller lik " & endraCelle.Offset(0, -4) & "!"
.ErrorTitle = "Feil i inndata."
.InputMessage = "Skriv inn datoen køyretøyet vart levert tilbake."
.InputTitle = "Dato."
End With
With endraCelle.Offset(0, 5).Validation
.Add Type:=xlValidateTime, AlertStyle:=xlValidAlertStop, Operator:=xlGreaterEqual, Formula1:="00:00"
.ErrorMessage = "Verdien i denne kolonna må vere eit tidspunkt, på forma" & Chr(34) & "TT:mm" & Chr(34) & "."
.ErrorTitle = "Feil i inndata."
.InputMessage = "Skriv inn kva tid køyretøyet vart levert tilbake."
.InputTitle = "Tid."
End With
Call lås_ark(registrering)
End Sub
I am sure there's an easier way to do it, but that's how the formula is generated in my workbook :P