Blocage Private Sub Worksheet_Change(ByVal Target As Range)
bonsoir a tous
je débute en VBA et la je bloque en ligne surligner jaune
le code entre les 2 surlignage bleu
fonctionne bien
le code et sur ma feuil nouvelle ref
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False 'force la majuscule
If Not Intersect(Target, Range("B8,D8,F8,H8,J8,L8,N8,P8")) Is Nothing Then
If Range("B8,D8,F8,H8,J8,L8,N8,P8") <> "" Then Target = UCase(Target)
End If
Application.EnableEvents = True
Dim cel As Range 'non trouvé en feuille "liste"
If Target.Address = "$B$8" Then
If Target = "" Then Exit Sub
With Sheets("Liste")
Set cel = .Columns("A").Find(what:=Target, LookIn:=xlValues, lookat:=xlWhole)
If Not cel Is Nothing Then
cel.Offset(0, 1).ClearContents
Else
MsgBox Target & " non trouvé"
End If
End With
End If
Sheets("nouvelle ref").Select
ActiveSheet.Unprotect
Range("H1").Select
Selection.Locked = False
Selection.FormulaHidden = False
rep = MsgBox("Connais-tu le mot de passe?", vbYesNo + vbQuestion, "Accès")
If rep = vbYes Then
mdp = "118"
If InputBox("Saisie du mot de passe :", "Accès") = mdp Then
Application.ScreenUpdating = False
Range("B8").Select
Selection.copy
Sheets("LISTE").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("e1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.FormulaR1C1 = "=SUM(RC[-3])"
Range("e2").Select
Sheets("nouvelle ref").Select
Range("B8").Select
Sheets("nouvelle ref").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Else: End If
Application.ScreenUpdating = False
ActiveSheet.Protect Password:="", AllowFiltering:=True
Range("B8").Activate
Application.ScreenUpdating = False
End If
End Sub
je joins un fichier plus explicite
merci par avance
aiglon74
Bonjour,
s.t.p > met ton code sous balise > voir l'icône > </> ...
Il faut éviter les .Select tant que c'est possible > de plus > cela donne du code plus rapide ...
Un essai ...
Private Sub Worksheet_Change(ByVal Target As Range)
'aiglon74
Application.ScreenUpdating = False
Application.EnableEvents = False 'force la majuscule
If Not Intersect(Target, Range("B8,D8,F8,H8,J8,L8,N8,P8")) Is Nothing Then
If Range("B8,D8,F8,H8,J8,L8,N8,P8") <> "" Then Target = UCase(Target)
End If
Application.EnableEvents = True
Dim cel As Range 'non trouvé en feuille "liste"
If Target.Address = "$B$8" Then
If Target = "" Then Exit Sub
With Sheets("Liste")
Set cel = .Columns("A").Find(what:=Target, LookIn:=xlValues, lookat:=xlWhole)
If Not cel Is Nothing Then
cel.Offset(0, 1).ClearContents
Else
MsgBox Target & " non trouvé"
End If
End With
End If
Sheets("nouvelle ref").Unprotect
Range("H1").Locked = False
Range("H1").FormulaHidden = False
rep = MsgBox("Connais-tu le mot de passe?", vbYesNo + vbQuestion, "Accès")
If rep = vbYes Then
mdp = "118"
If InputBox("Saisie du mot de passe :", "Accès") = mdp Then
Range("B8").copy
Sheets("Liste").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Liste").Range("A1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Liste").Range("E1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Liste").Range("E1").FormulaR1C1 = "=SUM(RC[-4])"
Range("B8").Select
Sheets("nouvelle ref").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ActiveSheet.Protect Password:="", AllowFiltering:=True
End If
End Subric
Bonjour,
J'ai oublié de mentionner pourquoi "Range("A1").Select" ne fonctionnait pas ...
Le code est situé dans la feuille "nouvelle ref" > même si le code mentionne "Sheets("Liste").Select" > "Range("A1") n'est pas accessible > il faut écrire Sheets("Liste").Range("A1").... ...
ric
Bonsoir ric
je teste et te tiens au courant
mais déjà merci pour ta réponse et tes explications qui me font avancé dans mon apprentissage
bonne soirée
aiglon
Bonsoir
je viens de teste ta macro
elle fonctionne bien 1 fois
a la 2eme fois elle recopie bien en a1 mais pas en e1
de + si la frappe en cellule b8 feuil nouvelle réf correspond bien a une cellule de la colonne b feuil base
le message Connais-tu le mot de passe apparait
hors il faudrait juste enregistrer
aiglon74
Bonjour,
Pas sûr d'avoir tout compris le fonctionnement désiré ...
Ni la référence à "H1" dans " Private Sub Worksheet_Change(ByVal Target As Range) " de la feuille "nouvelle ref" ...
Range("H1").Locked = False
Range("H1").FormulaHidden = False
Un essai ...
ric
bonsoir
je reprend mon explication
je voudrais que la macro fasse
Je tape R11TB2 en b8 (qui est en feuille liste colonne E1)
avec tabulation je passe a la cellule suivante tape une donnée
re tabulation re tape une donnée ect... et enregistre la ligne en feuille base
et moi j'ai une msgbox qui apparait a chacun cellule selectionner
h1 me serre (comme une porte) a faire apparaitre ma msgbox Connais-tu le mot de passe pas nécessaire mais je connais que ca comme système
et si en tapant RER en b8 (qui n' est pas en feuille liste colonne E1)
je voudrais MsgBox Target & " non trouvé"
MsgBox("Connais-tu le mot de passe?"
oui
InputBox("Saisie du mot de passe)
taper le mot de passe
continuer la saisie
puis enregistrer la ligne en feuille base
et si en tapant RER en b8 (qui n' est pas en feuille liste colonne E1)
je voudrais MsgBox Target & " non trouvé"
MsgBox("Connais-tu le mot de passe?"
non
retour en cellule b8
espère être plus clair
encore merci de prendre du temps
aiglon74
Bonjour,
J'ai un petit souci à la maison > je reviens bientôt ...
ric
Bonsoir
désolé pour ton petit souci
j'espère rien de grave
A+
aiglon74
Bonjour,
Je n'ai pas testé tout le code > seulement une partie ...
J'ai quand même touché un peu à " Sub valider_nouvelle_donnée() "
Au besoin > l'on reverra la suite ...
A+
ric
Bonsoir Ric
tout d'abord j'espère que ton petit souci et résolu
je viens de teste ta macro
nickel tip top
merci pour ton aide précieuse
et pour la leçon
A+
Aiglon74