Changer contenu de cellule en fonction d'une autre cellule en VBA
Effectivement, les projet viens d'évoluer, j'ai rajouté des colonnes dans la présentation, il me semblais que les zones étaient correctement identifiées... Mais non !
les différentes zones de double clic sont bien :
"T10:T44", "Z10:AB44", "AD10:AE44", "AG10:Ai44", "AM10:AR44" et "AU10:AY44"
Ok. Voici ce que vous devez faire
- Supprimez la macro double click dans toutes les feuilles CLASSE
- Allez dans Thisworkbook et mettez le code ci-dessous
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim plage As Range
If stpevt = True Then Exit Sub
If Left(Sh.Name, 6) = "Classe" Then
Set plage = Union(Range("Z10:AB44"), Range("AD10:AE44"), Range("AG10:Ai44"), Range("AM10:AR44"), Range("T10:T44"))
If Not Intersect(Target, plage) Is Nothing Then
stpevt = True
Cancel = False
With Target
If IsEmpty(.Value) Then
.Font.Name = "Wingdings"
.Font.Size = 20
.Value = "ü"
Else: .Value = vbNullString
End If
End With
Cancel = True
End If
stpevt = False
End If
End Sub- Une fois fait, faites un test.
Si ok, modifiez le code Private Sub Workbook_BeforeClose(Cancel As Boolean) comme ceci :
- Juste en dessous de Set shSynthese = ajoutez cette instruction --> stpevt = True
- juste avant le END SUB, ajoutez cette instruction --> stpevt = False
D'autre part, je mettrais l'instruction Application.screenupdating = False en début de code et remettre l'instruction à valeur True à la fin du code
Un seul mot, et en majuscule : MERCI !
Je me prends encore plus conscience du fossé que j'ai devant moi pour élaborer de tels codes...
Je continue de toutes façons à essayer de comprendre les déroulements de ces différents codes, en espérant un jour (à un bien moindre niveau :-) ) pouvoir aider à mon tour.
J'aurai une éventuelle dernière demande concernant uniquement la zone "T10:T44" : serait-il possible de faire apparaitre "Abs" à la place de la coche des autres zones ?
et ce sera ma dernière sollicitation car je suis amplement satisfait.
Encore BRAVO et merci pour le sacré coup de main.
J'aurai une éventuelle dernière demande concernant uniquement la zone "T10:T44" : serait-il possible de faire apparaitre "Abs" à la place de la coche des autres zones ?
Alors il faut modifier le code. Prenez celui ci
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim plage As Range
If stpevt = True Then Exit Sub
If Left(Sh.Name, 6) = "Classe" Then
Set plage = Union(Range("Z10:AB44"), Range("AD10:AE44"), Range("AG10:Ai44"), Range("AM10:AR44"), Range("T10:T44"))
If Not Intersect(Target, plage) Is Nothing Then
stpevt = True
Cancel = False
If Target.Column = 20 Then 'colonne T
With Target
If IsEmpty(.Value) Then
.Value = "Abs"
Else: .Value = vbNullString
End If
End With
Else:
With Target
If IsEmpty(.Value) Then
.Font.Name = "Wingdings"
.Font.Size = 20
.Value = "ü"
Else: .Value = vbNullString
End If
End With
End If
Cancel = True
End If
stpevt = False
End If
End SubMe voilà comblé. je me suis juste permis de remettre la police et la taille attendue, et c'est exactement le fichier "intuitif" que je souhaitais partager avec l'équipe d'éducateur.
Merci encore pour votre aide, votre écoute et votre rapidité.
Cordialement
ET bien voilà, j'ai parlé trop vite... les modifications apportées sont complètement fonctionnelles, mais je n'avais pas parlé de protection par mot de passe de chacune des feuilles "Classe x", et je pense que cela influe sur le déroulement de la macro. Je voudrais pourtant protéger l'accès à certaine cellules; comment dois-je m'y prendre svp ?
Je voudrais pourtant protéger l'accès à certaine cellules; comment dois-je m'y prendre svp ?
Waouh ! là c'est autre chose.
C'est toujours possible mais il faut expliquer ce que vous protégez. Ensuite il faut modifier un peu le code.
Pour protéger la feuille, sélectionnez toutes les cellules à protéger, ensuite vous allez dans l'onglet Révision --> Protéger la feuille et vous verrez les cases à cocher. Par défaut les deux premières case à cocher sont cochées
Ensuite mettez un mot de passe (ne l'oubliez pas...) que vous me donnez et je modifierai le code
Bonjour Dan,
les feuilles sont déjà prêtes à être protégées. je ne souhaite laisser accessible aux éducateurs uniquement les cellules qui demande des renseignement et les cases à cocher. Tout le reste devrait être inaccessible. Donc dans l'onglet Révision -> Protéger la feuille, je ne coche que "sélectionner les cellules déverrouillées"
Le mot de passe actuel est "pic"
Bonjour
les feuilles sont déjà prêtes à être protégées. je ne souhaite laisser accessible aux éducateurs uniquement les cellules qui demande des renseignement et les cases à cocher. Tout le reste devrait être inaccessible. Donc dans l'onglet Révision -> Protéger la feuille, je ne coche que "sélectionner les cellules déverrouillées"
Le mot de passe actuel est "pic"
Ok ce n'est pas trop compliqué. Faite ceci dans le code Private Sub Workbook_SheetBeforeDoubleClick
- En dessous de la ligne If Left(Sh.Name, 6) = "Classe" Then ajoutez la ligne ci-dessous
Sheets(Sh.Name).Unprotect = "pic"- Plus bas dans le code juste en dessous de l'instruction stpevt = False, ajoutez cette ligne
Sheets(Sh.Name).Protect = "pic"Rem : si vous voulez changer le mot de passe, il faudra penser à le faire à deux endroits du code. Si vous trouvez cela plus compliqué, on peut procéder autrement bien entendu.
Reste peut être votre code Before_Close qui m'a l'air d'être assez lent. A voir si chez vous cela fonctionne de manière fluide
Cordialement
Modifications effectuées, mais il me demande le mot de passe après chaque double clic !! (donc débogage). même réaction sur toutes les feuilles.
Effectivement le Before_close prend quelques secondes, mais reste fonctionnel (je reste tout de même attentif et intéressé par les améliorations possibles
Merci
Modifications effectuées, mais il me demande le mot de passe après chaque double clic !! (donc débogage). même réaction sur toutes les feuilles.
désolé mais il faut enlever le signe = dans les deux lignes
Maintenant il va falloir aussi rajouter ces deux instructions dans le code Workbook_SheetChange
Pour Unprotect, c'est au même endroit que précédemment
Pour Protect, vous mettez l'instruction à la fin juste avant le END IF
Si changement, vous devrez le changer à 4 endroits....
Un peu de temps pour essayer pas mal de choses ; toutes les feuilles sont protégées, les doubles clic fonctionnent, mais les "coches" n'apparaissent plus en fonction du palier choisi (Ix = 2, Ix = 3) elles n’apparaissent plus (débogage dans le Private Sub Workbook_SheetChange, au niveau de la ligne .Font.Name = "Wingdings")
elles n’apparaissent plus (débogage dans le Private Sub Workbook_SheetChange, au niveau de la ligne .Font.Name = "Wingdings")
Oui je vous ai écrit qu'il faut modifier aussi dans ce code. L'avez vous fait ?
Oups !!!
Bien évidemment non... J'étais trop pressé de valider et d'éssayer les premiers changements...
A nouveau un grand MERCI ; le fichier est totalement fonctionnel
(je reste néanmoins à l'écoute et attentif à la possibilité d'accélérer le before_Close..)
ok.
Si vous changez de mot de passe, n'oubliez pas qu'il faudra le changer 4 x (comme je vous ai expliqué avant). Si trop contraignant, on modifie
Je vais regarder pour le Before_close si on peut faire quelque chose
Mais déjà vous avez bien rajouté ce que je vous ai écrit à la fin de ce post --> https://forum.excel-pratique.com/s/goto/1076528
Complètement. J'avais même complété la ligne Set Plage = Union( .... avec un Range suplémentaire pour la zone "AU10:AY44"
Merci beaucoup
Re,
Bon un truc que je me demande c'est à quoi vous sert la colonne B dans les feuilles Classe ou plutot quel est le but ?
Pour le code de sortie, dans la ligne If derLigne >= 10 il vous faut aussi rajouter ceci derrière --> .Cells(derLigne + 1, 3) > 0
En effet en mettant cette instruction en plus, le code ne prendra pas en compte les lignes vides de la classe concernée
Bonjour Dan,
Les collègues récupèrent toutes les données des tests effectués, qui seront à partir de la saison prochaine, enregistrés dans une base de données, permettant un suivi individualisé le temps du cycle II et III en primaire. Suivi, et justification de l'obtention des tests (ou non) auprès des Conseillés pédagogiques.
Le but de la colonne B est de permettre de rendre unique l'élève dans la base de donnée pendant tout le suivi de sa scolarité. (base de donnée qui se construira avec la compilation du tableau "synthèse élèves".
Merci pour l'intérêt que vous portez sur ce travail
Bien cordialement
Bonjour
Le but de la colonne B est de permettre de rendre unique l'élève dans la base de donnée pendant tout le suivi de sa scolarité. (base de donnée qui se construira avec la compilation du tableau "synthèse élèves".
Je me doutais un peu de cela. Bon le seul intérêt de garder une formule là est le code Private Sub Workbook_BeforeClose qui utilise la ligne complète de chaque élève pour reporter dans la synthèse. Mais, vu que les colonnes C, D et E sont sauvegardées dans la feuille Synthèse, on aurait aussi pu créer cette colonne par code après la sauvegarde ou y mettre la formule. L'intérêt étant de ne plus avoir de formule dans la colonne B de chaque classe. Résultat, on accélère le traitement du fichier
Déjà vous pouvez remplacer votre code Before Close par celui ci-dessous. J'ai supprimé la boucle de suppression de lignes qui ralentissait le code.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet, shSynthese As Worksheet
Dim derLigne As Integer
Dim tmp()
Dim dl As Long
Application.ScreenUpdating = False ' pas de visibilité à l'écran
Set shSynthese = Sheets("Synthèse_élèves") ' Crée l'alias de la feuille synthèse
stpevt = True
If shSynthese.ListObjects("tb_synthese").ListRows.Count > 0 Then ' Vérifie que le tableau "tb_synthese" n'est pas vide
shSynthese.ListObjects("tb_synthese").DataBodyRange.Delete ' Si c'est le cas on le vide
End If
For Each sh In Worksheets ' Pour chaque feuille
If Left(sh.Name, 6) = "Classe" Then ' Si le nom commence par "Classe"
With Sheets(sh.Name)
derLigne = .Cells(.Rows.Count, 2).End(xlUp).Row ' On cherche le numéro de la dernière ligne de la colonne des noms
If derLigne >= 10 And .Cells(derLigne + 1, 3) > 0 Then ' On vérifie qu'il y bien des élèves dans cette classe
tmp = .Range(.Cells(10, 2), .Cells(derLigne, 24)).Value2 ' On transfère les données en mémoire
derLigne = shSynthese.ListObjects("tb_synthese").ListRows.Count ' On cherche la dernière ligne non vide de la feuille synthèse
Range("tb_synthese").Cells(derLigne + 1, 1).Resize(UBound(tmp), UBound(tmp, 2)) = tmp ' Et on écrit les donéées stockées en mémoire sur la feuille à la ligne suivante
End If
End With
End If
Next sh ' On fait la même chose pour la feuille suivante
With Sheets("Synthèse_élèves")
dl = .Cells.SpecialCells(xlLastCell).Row
.Range("A2:A" & dl).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
stpevt = False
Application.ScreenUpdating = True ' retour de visibilité à l'écran
Sheets("Classe 1").Select
Range("D1").Select
End SubBonjour Dan,
je reste stupéfait, c'est effectivement beaucoup plus rapide; incomparable avec le code précédent...
Que dire d'autre encore que MERCI, et une fois de plus, grande satisfaction.