Beste allemaal,
Voor mijn werk ben ik bezig met het maken van beveiligde geautomatiseerde sheets. Dat werkt op zich prima.
Maar nu wilde ik de mogelijkheid invoegen om gebruikers wel de mogelijkheid te geven om het formaat van de cellen te wijzigen en om hyperlinks in te voegen.
Alle codes werken afzonderlijk. De combinatie van formules en acties werkt in beginsel ook. Totdat ik de functies ging invoegen voor het toestaan van rijen in formaat te veranderen en de hyperlinks toe te staan. Hierna weigerden enkele rijen te verbergen, die voorheen wel op commando verborgen werden etc etc.
Is er iemand die een idee heeft waarom de combinatie niet werkt?
Hierbij de gebruikte codes:
Ik ben degene die mij kan helpen, heel erg dankbaar.
Alvast bedankt en groetjes,
Michel
Voor mijn werk ben ik bezig met het maken van beveiligde geautomatiseerde sheets. Dat werkt op zich prima.
Maar nu wilde ik de mogelijkheid invoegen om gebruikers wel de mogelijkheid te geven om het formaat van de cellen te wijzigen en om hyperlinks in te voegen.
Alle codes werken afzonderlijk. De combinatie van formules en acties werkt in beginsel ook. Totdat ik de functies ging invoegen voor het toestaan van rijen in formaat te veranderen en de hyperlinks toe te staan. Hierna weigerden enkele rijen te verbergen, die voorheen wel op commando verborgen werden etc etc.
Is er iemand die een idee heeft waarom de combinatie niet werkt?
Hierbij de gebruikte codes:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("D27:E32")
Dim c As Range
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
ActiveSheet.Unprotect Password:="testtest"
KeyCells.Rows.AutoFit
For Each c In Range("C27:C32")
If c = "Question is not applicable." Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
If ActiveSheet.Protection.AllowInsertingHyperlinks = False Then
ActiveSheet.Protect AllowInsertingHyperlinks:=True
End If
If ActiveSheet.Protection.AllowFormattingRows = False Then
ActiveSheet.Protect AllowFormattingRows:=True
End If
ActiveSheet.Protect Password:="testtest"
End If
Dim KeyCell As Range
Set KeyCell = Range("D14:E15")
Dim consultancy As Range
If Not Application.Intersect(KeyCell, Range(Target.Address)) _
Is Nothing Then
ActiveSheet.Unprotect Password:="testtest"
KeyCell.Rows.AutoFit
For Each consultancy In Range("B14:B21")
If consultancy = "Question is not applicable." Then
consultancy.EntireRow.Hidden = True
Else
consultancy.EntireRow.Hidden = False
End If
Next consultancy
If ActiveSheet.Protection.AllowInsertingHyperlinks = False Then
ActiveSheet.Protect AllowInsertingHyperlinks:=True
End If
If ActiveSheet.Protection.AllowFormattingRows = False Then
ActiveSheet.Protect AllowFormattingRows:=True
End If
ActiveSheet.Protect Password:="testtest"
End If
Dim KeyCel As Range
Set KeyCel = Range("D19:E32")
Dim Fundman As Range
If Not Application.Intersect(KeyCel, Range(Target.Address)) _
Is Nothing Then
ActiveSheet.Unprotect Password:="testtest"
KeyCel.Rows.AutoFit
For Each Fundman In Range("B19:B21")
If Fundman = "Question is not applicable." Then
Fundman.EntireRow.Hidden = True
Else
Fundman.EntireRow.Hidden = False
End If
Next Fundman
If ActiveSheet.Protection.AllowFormattingRows = False Then
ActiveSheet.Protect AllowFormattingRows:=True
End If
If ActiveSheet.Protection.AllowInsertingHyperlinks = False Then
ActiveSheet.Protect AllowInsertingHyperlinks:=True
End If
ActiveSheet.Protect Password:="testtest"
End If
Dim StatusI As Range
Set StatusI = Range("D37:D37")
If Not Application.Intersect(StatusI, Range(Target.Address)) _
Is Nothing Then
ActiveSheet.Unprotect Password:="testtest"
If Range("D37") = "Approved" Or Range("D37") = "Declined" Or Range("D37") = "Concept" Or Range("D37") = "In Progress" Or Range("D37") = "Waiting for client" Then
Range("D38").Select
ActiveCell.FormulaR1C1 = Application.Username
Range("D39").Select
ActiveCell.Formula = "=Now()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If ActiveSheet.Protection.AllowInsertingHyperlinks = False Then
ActiveSheet.Protect AllowInsertingHyperlinks:=True
End If
If ActiveSheet.Protection.AllowFormattingRows = False Then
ActiveSheet.Protect AllowFormattingRows:=True
End If
ActiveSheet.Protect Password:="testtest"
End If
Dim StatusII As Range
Set StatusII = Range("D41:D41")
If Not Application.Intersect(StatusII, Range(Target.Address)) _
Is Nothing Then
ActiveSheet.Unprotect Password:="testtest"
If Range("D41") = "Approved" Or Range("D41") = "Declined" Or Range("D41") = "Concept" Or Range("D41") = "In Progress" Or Range("D41") = "Waiting for client" Then
Range("D42").Select
ActiveCell.FormulaR1C1 = Application.Username
Range("D43").Select
ActiveCell.Formula = "=Now()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If ActiveSheet.Protection.AllowFormattingRows = False Then
ActiveSheet.Protect AllowFormattingRows:=True
End If
If ActiveSheet.Protection.AllowInsertingHyperlinks = False Then
ActiveSheet.Protect AllowInsertingHyperlinks:=True
End If
ActiveSheet.Protect Password:="testtest"
End If
Dim SignOffII As Range
Set SignOffII = Range("D14:E15")
Dim II As Range
If Not Application.Intersect(SignOffII, Range(Target.Address)) _
Is Nothing Then
ActiveSheet.Unprotect Password:="testtest"
For Each II In Range("B41:B44")
If II = "Question is not applicable." Then
II.EntireRow.Hidden = True
Else
II.EntireRow.Hidden = False
End If
Next II
If ActiveSheet.Protection.AllowFormattingRows = False Then
ActiveSheet.Protect AllowFormattingRows:=True
End If
If ActiveSheet.Protection.AllowInsertingHyperlinks = False Then
ActiveSheet.Protect AllowInsertingHyperlinks:=True
End If
ActiveSheet.Protect Password:="testtest"
End If
End SubIk ben degene die mij kan helpen, heel erg dankbaar.
Alvast bedankt en groetjes,
Michel
