j'ai loupé un épisode je comprends rien

R

rem$

Guest
bonjour à tous

voilà je suis pas tres doué par les macros d'ou ma presence ici et de nbreux posts....

aujourd'hui je rassemble pas mal de macros dans ma feuille car la version finale je pointe a l'horizon
Michel_M m'a fourni une macro qui doit agir lors de changement dans un zone de mon tableau donc je l'ai placé dans le woorksheet_change. Cette macro renvoie une action qui se trouve dans le module 1.
dans cette feuille une autre macro doit me donner la date+heure de façon automatique lorsque je change le contenu de la cellule d'à côté donc elle se trouve également dans le woorsheet_change
et bien je n'arrive pas à executer les 2 macros ensembles la premiere est completement inactive dans ma feuille pourtant le module1 est bien activé je ne comprend pas

si qq'un a une idée de ce que je dois faire pour que ela fonctionne correctement ........
d'avance merci

@ bientot

Rem$
 
R

rem$

Guest
re

voici les 2 codes à mettre dans la feuille

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo noErr


If Not Application.Intersect(Target, Range("A4:A5000")) Is Nothing Then
Target.Offset(0, 1).Value = Now
If Target.Value = "" Then Target.Offset(0, 1).Value = ""
End If

le deuxieme
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A5:A578")) Is Nothing Then: Exit Sub
apparenter
End Sub


ca c dans le module1

Sub apparenter()
Dim cptr As Byte
Dim papier As Variant
Dim info As Variant


papier = Array(1, 5, 6, 7, 8, 10, 21) 'mettre tes numéros "papiers"
info = Array(3, 4, 9, 11, 12, 13, 14, 15, 16, 17, 18, 19) 'mettre tes numéros "informatique"

If ActiveCell = "" Then Exit Sub

If ActiveCell = 2 Or ActiveCell = 19 Then ' tes nombres interdits
MsgBox "ces N° d'APP n'existent pas"
Exit Sub
End If

cptr = 1
Do While cptr <= 7 ' nombre d'eléments du tableau "papiers"
If ActiveCell = papier(cptr) Then
MsgBox "cet APP n'est pas sur labguard vérifier, valider et conserver la courbe papier"
Exit Sub
End If
cptr = cptr + 1
Loop

cptr = 1
Do While cptr <= 12
If ActiveCell = info(cptr) Then
MsgBox "cet APP est connecté sur le labguard mettre la courbe au format informatique"
Exit Sub
End If
cptr = cptr + 1
Loop
MsgBox " valeurs non classée"


End Sub




merci
 
M

Michel_M

Guest
Salut rem$

La macro que tu as écrite pour le coup de l'heure est bizzare mais tu demandes 2 macros commandées par par le MEME EVENEMENT

Donc Excel se dit "entre les 2 mon coeur chavire"

Il faut donc q'une seule macro qui testera d'abord l'heure puis déclenchera apparenter

enfin, "On Error GoTo noErr" est curieux en t^te de macro


Michel
 
C

CHti160

Guest
Salut "rem$" et "Michel_M"

Oui j'ai aussi tenté de modifier, mais sans succès deux évênements
Worksheet_Change qui se chevauchent ,je n'ai rien trouvé de bon .Mais moi je suis un" bleu" il faut suivre ton post,On ne sait jamais
A+++
Jean Marie
 

Discussions similaires

Réponses
36
Affichages
2 K

Statistiques des forums

Discussions
314 162
Messages
2 106 603
Membres
109 638
dernier inscrit
psou