Bonjour,
zombe a écrit:Je disais que lorsque la valeur de la cellule B4 était différente de "CL" ou CH PARTICULIRE, qu'il y'ait copie.
Normalement, la macro que j'ai fournie est censée gérer ce cas de figure avec le code suivant :
- Code: Tout sélectionner
ElseIf Target.Address = "$B$48" And Target.Value <> "" Then
Call colorer_cellule
Call Macro10
GoTo fin
Cette partie est déjà dans le code se trouvant dans la feuille DONNE. En cas de saisie de données dans B48, on lance directement la macro10 (contrôle du contenu et copie des cellules) et la coloration des cellules.
zombe a écrit:Mais il reste un soucis : en protégeant mes feuilles, mes macros ne fonctionnent plus (leurs exécutions).
La protection des feuilles va poser un problème puisqu'elle va empêcher de modifier les cellules (la macro va donc planter ou s’arrêter).
Il existe une possibilité de désactiver et activer la protection depuis la macro.
Les commandes sont :
- Code: Tout sélectionner
ActiveSheet.Unprotect
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Ces commandes doivent être placées à l'ouverture d'une macro (pour le unprotect)
et à la fin de la macro (pour le protect)
Voici les codes des macros modifiés :
Code à insérer dans l'objet "feuil1 (DONNE)" :
- Code: Tout sélectionner
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo fin
ActiveSheet.Unprotect
If Range("B4").Value = "CH PARTICULIER" Then
If Target.Address = "$B$34" And Target.Value <> "" Then
Range("B36").Select
ElseIf Target.Address = "$B$37" And Target.Value <> "" Then
Range("B41").Select
ElseIf Target.Address = "$B$41" And Target.Value <> "" Then
Call colorer_cellule
Call Macro10
'Range("E3").Select
Else: GoTo fin
End If
ElseIf Range("B4").Value = "CL" Then
If Target.Address = "$B$18" And Target.Value <> "" Then
Range("B21").Select
ElseIf Target.Address = "$B$34" And Target.Value <> "" Then
Range("B36").Select
ElseIf Target.Address = "$B$37" And Target.Value <> "" Then
Range("B41").Select
ElseIf Target.Address = "$B$41" And Target.Value <> "" Then
Call colorer_cellule
Call Macro10
'Range("E3").Select
Else: GoTo fin
End If
ElseIf Target.Address = "$B$48" And Target.Value <> "" Then
Call colorer_cellule
Call Macro10
GoTo fin
Else: GoTo fin
End If
fin:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub colorer_cellule()
Dim cpt As Integer
'
' Macro1 Macro
' Macro enregistrée le 30/09/2011 par Sebastien
'
'
ActiveSheet.Unprotect
Range("B5").Select
cpt = 0
Do While cpt < 46 'permet de tester de B5 à B50
If ActiveCell.Value = "" Then
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
ActiveCell.Offset(1, 0).Select
cpt = cpt + 1
Else
ActiveCell.Offset(1, 0).Select
cpt = cpt + 1
End If
Loop
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Code à insérer dans un module :
- Code: Tout sélectionner
Option Explicit
Sub Macro10()
'E13, B5, B17, B41 et F20 ne sont pas vide, que ces cellules soient copiées et collées sur la feuille MANK.
Dim b, c, d, e, f, g As String
ActiveSheet.Unprotect
'selection de la feuille de saisie
Sheets("DONNE").Select
'verification des cellules à copier
If Range("E13").Value = "" Then
MsgBox ("E13 est vide")
ElseIf Range("B5").Value = "" Then
MsgBox ("B5 est vide")
ElseIf Range("B17").Value = "" Then
MsgBox ("B17 est vide")
ElseIf Range("B41").Value = "" Then
MsgBox ("B41 est vide")
ElseIf Range("F20").Value = "" Then
MsgBox ("F20 est vide")
ElseIf Application.WorksheetFunction.CountIf(Sheets("MANK").Range("D4:D" & Sheets("MANK").Range("D65536").End(xlUp).Row), Range("B41").Value) > 0 Then
MsgBox ("Ce compte est déjà présent dans la feuille MANK")
Else
'copie des cellules
b = Range("B5").Value 'nom_prenom
c = Range("E13").Value 'E13
d = Range("b17").Value 'téléphone
e = Range("B41").Value 'n° compte
f = Range("F20").Value 'date
g = Range("B5").Value 'nom_prenom pour colonne identité
'selection de la feuille de destination
Sheets("MANK").Select
'selection de la première cellule de destination
Range("B3").Select
'vérification de la cellule de destination
If ActiveCell.Value = "" Then 'si la cellule est vide, on colle
ActiveCell = b
ActiveCell.Offset(0, 1) = f
ActiveCell.Offset(0, 2) = e
ActiveCell.Offset(0, 3) = g
ActiveCell.Offset(0, 4) = d
ActiveCell.Offset(0, 5) = c
Sheets("DONNE").Select
Range("E3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
Else 'la cellule n'est pas vide
'on boucle tant que la cellule de destination n'est pas vide
Do While ActiveCell.Value <> ""
'selection de la cellule du dessous
ActiveCell.Offset(1, 0).Select
'si la cellule est vide, on colle
If ActiveCell.Value = "" Then
ActiveCell = b
ActiveCell.Offset(0, 1) = f
ActiveCell.Offset(0, 2) = e
ActiveCell.Offset(0, 3) = g
ActiveCell.Offset(0, 4) = d
ActiveCell.Offset(0, 5) = c
Sheets("DONNE").Select
Range("E3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
Else
'selection de la cellule du dessous
ActiveCell.Offset(1, 0).Select
End If
Loop 'on boucle tant que la cellule n'est pas vide
End If
'si la cellule est vide, fin de la boucle, et on colle
ActiveCell = b
ActiveCell.Offset(0, 1) = f
ActiveCell.Offset(0, 2) = e
ActiveCell.Offset(0, 3) = g
ActiveCell.Offset(0, 4) = d
ActiveCell.Offset(0, 5) = c
Sheets("DONNE").Select
Range("E3").Select
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Il faudra mettre ces commandes dans les autres macros éventuellement présentes et qui modifieraient des cellules.
Par contre, il faudra dans tous les cas ne pas protéger la plage B4:B50, sinon la saisie sera impossible.
Je n'ai pas eu le temps de tester tous les cas de figures (CL, CH PARTICULIER, cellules manquantes, doublons etc.). Testez les différents cas pour voir s'il n'y a pas de bug.
PS : dans l'exemple ci-dessus, les feuilles sont protégées sans mot de passe. S'il y a un mot de passe, il faut ajouter le critère Password:= "mypassword" dans les paramètres protect et unprotect, mypassword étant le mot de passe.
@+
