excel...comment faire !

excel...comment faire ! - VB/VBA/VBS - Programmation

Marsh Posté le 30-07-2009 à 16:00:14    

Bonjour !
J'ai retourné le problème dans tout les sens avant de vous le soumettre !
 
[img]c:\excel.JPG[/img]
 
Merci

Reply

Marsh Posté le 30-07-2009 à 16:00:14   

Reply

Marsh Posté le 30-07-2009 à 16:02:29    

mince ! j'avais préparé une image pour vous montrer mais ca passe pas !
Comment on intègre une image ici ?

Reply

Marsh Posté le 30-07-2009 à 16:21:53    

En faite, je veux que mes calculs se positionnent dans la colonne K
   -> Si la cellule F= rien alors rien dans K (même si elle a un chiffre dans la colonne B)  --> pas de calcul
   -> Si une cellule de la colonne B = 1 (ex : B3) et que F <>de rien (sur la même ligne)
           alors Si B4 > 1
                      alors K3 = J3
                      sinon si B4 = rien
                                 alors Tant que les cellules du dessous (B5 , B6 , B7 , etc...)sont = à rien alors on additionne les cellules J correspondante dans la cellule K3 (et normalement on doit obtenir la somme de J3:J7)
                                 sinon K3=J3
 
J'ai fait cette formule :
=SI(F65="";"";SI(B65<>1;"";SI(B65=1;SI(B66>1;SOMME(J65);SI(B66=1;SOMME(J65);SI(B67=1;SOMME(J65:J66);SI(B68=1;SOMME(J65:J67))))))))
 
mais elle marche pas si j'ai plus de 1 cellule vide après !
 
Avez vous compris !?!
C'est plus simple avec mon image mais j'arrive pas a la mettre !
 

Reply

Marsh Posté le 31-07-2009 à 11:26:48    

personne a une idée !?

Reply

Marsh Posté le 31-07-2009 à 12:41:58    

Bonjour
 
Si tu ne sais pas monter une image sur ImageHacks, envoie moi l'image sur mon mail, il est dans mon profil. Je la partagerai ici, si tu le souhaites...
 
Je zieute ca des que j'ai la photo ou meme le fichier (Avec le fichier ca sera meme plus simple... En fonction de ce qu'il contient et si tu peux ou pas le transmettre)
 
PS : Somme(J65) <(---- Je ne vois pas trop a quoi cela sert...
 
Cordialement


Message édité par SuppotDeSaTante le 31-07-2009 à 12:42:50

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 01-08-2009 à 00:40:33    

Tiens, ca avait l'air urgentissime.......

Message cité 1 fois

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 05-08-2009 à 10:37:48    

SuppotDeSaTante a écrit :

Tiens, ca avait l'air urgentissime.......


 
Salut !
Désolé mais j'ai plein de taf en ce moment et j'ai pas eu le temps de te répondre !
 
Donc oui j'ai toujours pas la solution ! Je t'envoie le fichier !
Merci pour ton aide

Reply

Marsh Posté le 05-08-2009 à 11:13:15    

pourrais-tu mettre l'image sur le site indiqué précédemment pour qu'on puisse avoir une illustration du soucis?
Car perso j'ai pas très bien compris ton soucis ^^

Reply

Marsh Posté le 05-08-2009 à 16:28:42    

Hello
 
Donc deja l'image (j'ai flouté les noms pour la confidentialité de tes données) :
http://dje69r.free.fr/lea133.jpg
 
Ensuite le code :

Code :
  1. Function lea133()
  2. On Error Resume Next
  3. Cells(35536, 1).Select
  4. Range(Selection, Selection.End(xlToRight)).Select
  5. Range(Selection, Selection.End(xlUp)).Select
  7. DerLin = ActiveCell.Row
  8. DebLin = 11
  10. For x = 1 To DerLin
  11.     CellSomme = Cells(DebLin, 10)
  12.     CellDeb = DebLin
  13.     While Cells(DebLin + 1, 2) = ""
  14.         CellSomme = CellSomme + Cells(DebLin + 1, 10).Value
  15.         DebLin = DebLin + 1
  16.         x = DebLin
  17.         Valeur = True
  18.         If DebLin > DerLin Then Exit Function
  19.     Wend
  20.    
  21.     If Valeur = True Then Cells(CellDeb, 11).Value = CellSomme
  22.     DebLin = DebLin + 1
  23.     Valeur = False
  24. Next x
  26. End Function


 
je n'ai pas fait ce que tu demandes pour les lignes en couleur, j'ai pas tout pigé...
Si tu pouvais expliciter ici...
 
Merci
 
Dis moi si ca te va, normalement ca roule, j'ai fait l'essai en direct sur ton fichier


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 05-08-2009 à 16:55:18    

Je vais paraitre un peu bête mais le code je le met dans visual basic ?

Reply

Marsh Posté le 05-08-2009 à 16:55:18   

Reply

Marsh Posté le 05-08-2009 à 17:02:30    

ok ! j'ai trouvé comment faire...lol
C'est trop bien ce que tu m'a fait ! exactement ce que je voulais ! merci merci beaucoup ! Merci pour la confidentialité !
Les couleurs je vais m'en charger !
 
Une petite question : la fonction comment la relier a un bouton car pour mes utilisateur ca sera plus simple de l'utiliser ! merci !

Message cité 1 fois
Reply

Marsh Posté le 06-08-2009 à 09:43:59    

Re

lea133 a écrit :

ok ! j'ai trouvé comment faire...lol
C'est trop bien ce que tu m'a fait ! exactement ce que je voulais ! merci merci beaucoup ! Merci pour la confidentialité !

:jap:
Le but étant aussi que tu comprennes, si tu as des questions sur le code, n'hesites pas.
 

lea133 a écrit :

Les couleurs je vais m'en charger !

Ok, a mon avis le mieux c'est de l'integrer directement dans le While ou la ligne juste apres le Wend. Mais ce sont surtout tes conditions que je n'ai pas saisi
 

lea133 a écrit :

Une petite question : la fonction comment la relier a un bouton car pour mes utilisateur ca sera plus simple de l'utiliser ! merci !

Tu te créés un Sub qui appelle la fonction, et tu affecte la macro au Bouton. Les boutons ne peuvent appeler que des sub. Ou tu transformes la fonction en Sub.(Attention, il y a un Exit Function, le transformer en Exit Sub)
Tu créés un bouton, soit avec les dessins d'Excel, soit avec la barre d'outils "Boite a outils controle" qui est sur la barre Visual Basic
Une fois le bouton en place sur la feuille, click droit, Affecter à une macro.


Message édité par SuppotDeSaTante le 06-08-2009 à 09:52:22

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 10:28:36    

J'ai remarqué que ta fonction ne prend pas en compte si l'arrêt ou la maladie dure qu'une ligne ! J'ai donc laissé la formule : =SI(F12="";"";SI(B12=0;"";SI(B12>1;"";SI(B12=1;SI(B13>1;SOMME(J12);SI(B13=1;SOMME(J12);"" )))))) pour que ça prenne en compte !
 
Sinon, je sais pas comment intégrer le faite que si la cellule G d'une ligne est vide alors il n'y a pas de calcul !
Exemple : Ligne 55 ou 80 etc...
 
Sinon, pour la couleur, je vais ajouter une mise en forme conditionnelle ! Je sais pas encore si ça va marcher mais j'espère !
 
Les conditions c'est que :
 
- Si une personne a un accident de travail ou de trajet (AT ou ATR) alors si le nombre de jour est supérieur à 8 alors mon utilisatrice doit le voir direct...que ce soit par un code couleur ou un message !!! En faite, un accident de travail ou de trajet supérieur à 8 jours entraine une visite médicale à la reprise...c'est pour pas qu'elles oublie !
 
- Si une personne a une maladie (MAL) alors si le nombre de jour est supérieur à 21 alors mon utilisatrice doit le voir direct...que ce soit par un code couleur ou un message !!! Une maladie supérieur a 21 jours entraine une visite médicale...c'est pareil...pour pas qu'elles oublie !
 
Il ne faut pas se soucier des autres (mala, map, mp, etc ....)
 
Tu m'as comprise ?!

Reply

Marsh Posté le 06-08-2009 à 11:11:14    

Ouaip, compris :D
 
Regarde les modifs apportées

Citation :

Function lea133()
On Error Resume Next
Cells(35536, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlUp)).Select
 
DerLin = ActiveCell.Row
DebLin = 11
 
 
'On vire les commentaires pour les recalculer par la suite. _
ainsi que la couleur et le gras
Range("k:k" ).Select
Selection.ClearComments
Selection.Font.Bold = False
Selection.Font.ColorIndex = 0
 
For x = 1 To DerLin
    CellSomme = Cells(DebLin, 10)
    CellDeb = DebLin
    'Test pour les valeur ayant seulement 1
    If Cells(DebLin + 1, 2) <> "" Then
        Cells(CellDeb, 11).Value = CellSomme
    Else
        While Cells(DebLin + 1, 2) = ""
            CellSomme = CellSomme + Cells(DebLin + 1, 10).Value
            DebLin = DebLin + 1
            x = DebLin
            Valeur = True
            If DebLin > DerLin Then Exit Function
        Wend
    End If
    If Valeur = True Then Cells(CellDeb, 11).Value = CellSomme
    DebLin = DebLin + 1
    Valeur = False
     
    'Si At ou ATR et >8 jours, alors il met en rouge gras et ajoute un commentaire avec le nom et le prenom _
    Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
    If (InStr(1, Cells(CellDeb, 9).Value, "at", 1) <> 0 Or InStr(1, Cells(CellDeb, 9).Value, "atr", 1) <> 0) And Cells(CellDeb, 11).Value > 8 Then
        Cells(CellDeb, 11).Font.ColorIndex = 3
        Cells(CellDeb, 11).Font.Bold = True
        Cells(CellDeb, 11).AddComment Trim(Cells(CellDeb, 4)) & " " & Trim(Cells(CellDeb, 5)) & " : " & Chr(10) & Cells(CellDeb, 9) & " : " & Cells(CellDeb, 11) & " jours"
     
    'Si MAL et >21 jours, alors il met en bleu gras et ajoute un commentaire avec le nom et le prenom _
    Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
    ElseIf InStr(1, Cells(CellDeb, 9).Value, "mal", 1) <> 0 And Cells(CellDeb, 11).Value > 21 Then
        Cells(CellDeb, 11).Font.ColorIndex = 5
        Cells(CellDeb, 11).Font.Bold = True
        Cells(CellDeb, 11).AddComment Trim(Cells(CellDeb, 4)) & " " & Trim(Cells(CellDeb, 5)) & " : " & Chr(10) & Cells(CellDeb, 9) & " : " & Cells(CellDeb, 11) & " jours"
    End If
     
 
 
Next x
 
End Function


Message édité par SuppotDeSaTante le 06-08-2009 à 11:25:32

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 11:23:32    

Il me met une erreur a la ligne 34 :
Erreur de compilation. Else sans IF

Reply

Marsh Posté le 06-08-2009 à 11:26:17    

J'ai edité mon post entre temps, re-regarde mon dernier message


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 11:30:42    

OK...cool c'est vraiment super se que tu as fait !

Reply

Marsh Posté le 06-08-2009 à 11:31:31    

Pour ton histoire de la ligne 55 ou 80 je ferais ceci :
 
J55 : =Si(Ou(G55="";H55="" );"";H55-G55+1)
 
Comme ca du moment qu'une des dates n'est pas remplie, il ne fait pas le calcul


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 11:32:12    

Ca te va ?
 
J'ai mis les deux, couleur/gras plus commentaires, comme ca, ca te donne des pistes et te montre d'autres choses.


Message édité par SuppotDeSaTante le 06-08-2009 à 11:32:38

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 11:33:45    

Alors toujours dans le perfectionnement !
 
J'y avais pas pensé avant mais...une fois que l'AT ou la MAL est traité comment lui dire de ne pas le ou la re-traiter !
 
Je t'explique, mon utilisatrice a eu l'avertissement et a pris le rendez-vous chez la médecine du travail pour un employé.  
Comment faire pour pas qu'il continu a afficher l'avertissement lorsqu'elle clique sur le bouton ? car a chaque fois qu'elle va cliquer sur le bouton, tout va revenir !

Reply

Marsh Posté le 06-08-2009 à 11:34:29    

Bah tu le dis a quel moment et où qu'il ne faut plus le traiter ?
 
Sinon, si tu n'as pas prévu, il 'suffit' d'ajouter une case "Traité" et en fonction on passe ou pas dessus.


Message édité par SuppotDeSaTante le 06-08-2009 à 11:35:26

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 11:35:28    

Si tu sais pas, t'inquiète pas c'est pas grave !  
C'est déjà super ce que tu as fait pour moi...je te remercierai jamais assez pour ça !

Reply

Marsh Posté le 06-08-2009 à 11:39:30    

Ok c'est pas super...mais comment tu rajoute ça !???

Reply

Marsh Posté le 06-08-2009 à 11:41:30    

Si je leur fait mettre "Traité" dans la cellule K qui rentre dans les conditions d'un RDV chez médecine du travail...comment dire a la fonction que si il y a "Traité", il ne faut pas qu'il refasse le calcul !

Reply

Marsh Posté le 06-08-2009 à 11:42:49    

J'ai encore édité mon post.
 
Tu inseres une colonne en L
Tu la nommes Traité
Si tu mets 1 dedans, il ne la traitera pas, par exemple en L36 : 1
le 189 restera en normal
 

Citation :

Function lea133()
On Error Resume Next
Cells(35536, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlUp)).Select
 
DerLin = ActiveCell.Row
DebLin = 11
 
 
'On vire les commentaires pour les recalculer par la suite. _
ainsi que la couleur et le gras
Range("k:k" ).Select
Selection.ClearComments
Selection.Font.Bold = False
Selection.Font.ColorIndex = 0
 
For x = 1 To DerLin
    CellSomme = Cells(DebLin, 10)
    CellDeb = DebLin
    'Test pour les valeur ayant seulement 1
    If Cells(DebLin + 1, 2) <> "" Then
        Cells(CellDeb, 11).Value = CellSomme
        While Cells(DebLin + 1, 2) = ""
            CellSomme = CellSomme + Cells(DebLin + 1, 10).Value
            DebLin = DebLin + 1
            x = DebLin
            Valeur = True
            If DebLin > DerLin Then Exit Function
        Wend
    End If
    If Valeur = True Then Cells(CellDeb, 11).Value = CellSomme
    DebLin = DebLin + 1
    Valeur = False
     
    'Si At ou ATR et >8 jours, alors il met en rouge gras et ajoute un commentaire avec le nom et le prenom _
    Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
    If (InStr(1, Cells(CellDeb, 9).Value, "at", 1) <> 0 Or InStr(1, Cells(CellDeb, 9).Value, "atr", 1) <> 0) _
    And Cells(CellDeb, 11).Value > 8 And Cells(CellDeb, 12) <> 1 Then
        Cells(CellDeb, 11).Font.ColorIndex = 3
        Cells(CellDeb, 11).Font.Bold = True
        Cells(CellDeb, 11).AddComment Trim(Cells(CellDeb, 4)) & " " & Trim(Cells(CellDeb, 5)) & " : " & Chr(10) & Cells(CellDeb, 9) & " : " & Cells(CellDeb, 11) & " jours"
     
    'Si MAL et >21 jours, alors il met en bleu gras et ajoute un commentaire avec le nom et le prenom _
    Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
    ElseIf InStr(1, Cells(CellDeb, 9).Value, "mal", 1) <> 0 And Cells(CellDeb, 11).Value > 21 _
    And Cells(CellDeb, 12) <> 1 Then
        Cells(CellDeb, 11).Font.ColorIndex = 5
        Cells(CellDeb, 11).Font.Bold = True
        Cells(CellDeb, 11).AddComment Trim(Cells(CellDeb, 4)) & " " & Trim(Cells(CellDeb, 5)) & " : " & Chr(10) & Cells(CellDeb, 9) & " : " & Cells(CellDeb, 11) & " jours"
    End If
     
 
 
Next x
 
End Function


Message édité par SuppotDeSaTante le 06-08-2009 à 11:44:20

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 11:44:14    

OK ! et c'est possible la solution que je t'ai soumis dans mon précédent post ? Ce qui évitera de rajouter une colonne

Reply

Marsh Posté le 06-08-2009 à 11:50:39    

Je ne trouve pas ca tres logique. Tu enleves une somme de jours. Meme si l'info ne doit plus etre traitée, je pense qu'il faut tout de meme garder la somme...
 
En plus le fait d'ajouter une colonne te permettrai d'avoir, grace au filtre, le nombre de jour traité pour un individu...
 
Apres, si par exemple le 189 ne doit plus apparaitre, ca reste simple.
 

Citation :

Function lea133()
On Error Resume Next
Cells(35536, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlUp)).Select
 
DerLin = ActiveCell.Row
DebLin = 11
 
 
'On vire les commentaires pour les recalculer par la suite. _
ainsi que la couleur et le gras
Range("k:k" ).Select
Selection.ClearComments
Selection.Font.Bold = False
Selection.Font.ColorIndex = 0
 
For x = 1 To DerLin
    CellSomme = Cells(DebLin, 10)
    celldeb = DebLin
    'Test pour les valeur ayant seulement 1
    If Cells(DebLin + 1, 2) <> "" Then
        Cells(celldeb, 11).Value = CellSomme
        If Cells(celldeb, 11).Value <> "Traité" Then
            While Cells(DebLin + 1, 2) = ""
                CellSomme = CellSomme + Cells(DebLin + 1, 10).Value
                DebLin = DebLin + 1
                x = DebLin
                Valeur = True
                If DebLin > DerLin Then Exit Function
            Wend
        End If
    End If
    If Valeur = True Then Cells(celldeb, 11).Value = CellSomme
    DebLin = DebLin + 1
    Valeur = False
     
    'Si At ou ATR et >8 jours, alors il met en rouge gras et ajoute un commentaire avec le nom et le prenom _
    Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
    If (InStr(1, Cells(celldeb, 9).Value, "at", 1) <> 0 Or InStr(1, Cells(celldeb, 9).Value, "atr", 1) <> 0) _
    And Cells(celldeb, 11).Value > 8 And Cells(celldeb, 11) <> "Traité" Then
        Cells(celldeb, 11).Font.ColorIndex = 3
        Cells(celldeb, 11).Font.Bold = True
        Cells(celldeb, 11).AddComment Trim(Cells(celldeb, 4)) & " " & Trim(Cells(celldeb, 5)) & " : " & Chr(10) & Cells(celldeb, 9) & " : " & Cells(celldeb, 11) & " jours"
     
    'Si MAL et >21 jours, alors il met en bleu gras et ajoute un commentaire avec le nom et le prenom _
    Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
    ElseIf InStr(1, Cells(celldeb, 9).Value, "mal", 1) <> 0 And Cells(celldeb, 11).Value > 21 _
    And Cells(celldeb, 11) <> "Traité" Then
        Cells(celldeb, 11).Font.ColorIndex = 5
        Cells(celldeb, 11).Font.Bold = True
        Cells(celldeb, 11).AddComment Trim(Cells(celldeb, 4)) & " " & Trim(Cells(celldeb, 5)) & " : " & Chr(10) & Cells(celldeb, 9) & " : " & Cells(celldeb, 11) & " jours"
    End If
     
 
     
Next x
 
End Function


 
il faut que tu saisisses "Traité" en K, mais je le repète tu enleves de l'information, a toi de voir.


Message édité par SuppotDeSaTante le 06-08-2009 à 11:53:32

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 11:54:15    

J'ai re-édité mon post précédent. A verfier


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 11:58:22    

OK ! C'est clair que c'est mieux de rajouter une colonne !
 
En faite, je croyais que dans l'info bull, le nombre de jours associé serait resté !  
Et donc la colonne K affichait "traité" ou le nombre de jours et dans les info bull de traité si on voulait le détail, le nombre de jours y était inscrit !

Reply

Marsh Posté le 06-08-2009 à 12:00:49    

Ahum
 
Attends je zieute ca !
 
Exigente la miss !! :p


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 12:06:31    

LoL !
Tant que j'ai un pro sous la main !
 
Ta fonction précédente ne fonctionne pas !  
J'ai changé K36 et K45...ca a marché !
Mais après j'ai vouu faire K43 et K48 et rien ne se passe...

Reply

Marsh Posté le 06-08-2009 à 12:09:04    

Si avec ça t'as pas un num à quoi sert l'informatique  :D  
 
 
http://www.developpez.net/forums/images/smilies/dehors.gif

Reply

Marsh Posté le 06-08-2009 à 12:11:53    

LOL _xme_ !

Reply

Marsh Posté le 06-08-2009 à 12:13:40    

Mdr _xme_
 
J'ai deja le (un) mail ^^  
Chaque chose en son temps voyons !
 
je zieute apres ma pause miamage ;)


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 12:15:34    

OK pas de problème !
Bon ap
 
Merci

Reply

Marsh Posté le 06-08-2009 à 14:50:49    

And the last one is :
 

Citation :

Sub lea133
On Error Resume Next
Cells(35536, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlUp)).Select
 
DerLin = ActiveCell.Row
DebLin = 11
 
 
'On vire les commentaires pour les recalculer par la suite. _
ainsi que la couleur et le gras
Range("k:k" ).Select
Selection.ClearComments
Selection.Font.Bold = False
Selection.Font.ColorIndex = 0
 
For x = 1 To DerLin
    CellSomme = Cells(DebLin, 10)
    celldeb = DebLin
         
    'Booleen pour voir si il y a "traité" ou pas dns la cellule
    If InStr(1, Cells(celldeb, 11), "Traité", 1) <> 0 Then Traite = True
    'Test pour les valeur ayant seulement 1
    If Cells(DebLin + 1, 2) <> "" Then
        Cells(celldeb, 11).Value = CellSomme
    Else
        While Cells(DebLin + 1, 2) = ""
            CellSomme = CellSomme + Cells(DebLin + 1, 10).Value
            DebLin = DebLin + 1
            x = DebLin
            Valeur = True
            If DebLin > DerLin Then GoTo Fin
        Wend
    End If
    If Valeur = True Then
        Cells(celldeb, 11).Value = CellSomme
    End If
     
    'S'il y avat traité, il remet traité a la place du nb, mais mets le nb par la suite dans le commentaire.
    If Traite = True Then
        Cells(celldeb, 11).Value = "Traité " & CellSomme
        Traite = False
    End If
    DebLin = DebLin + 1
    Valeur = False
     
    'Si At ou ATR et >8 jours, alors il met en rouge gras et ajoute un commentaire avec le nom et le prenom _
    Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
    If (InStr(1, Cells(celldeb, 9).Value, "at", 1) <> 0 Or InStr(1, Cells(celldeb, 9).Value, "atr", 1) <> 0) And Cells(celldeb, 11).Value > 8 Then
        Cells(celldeb, 11).Font.ColorIndex = 3
        Cells(celldeb, 11).Font.Bold = True
        Cells(celldeb, 11).AddComment Trim(Cells(celldeb, 4)) & " " & Trim(Cells(celldeb, 5)) & " : " & Chr(10) & Cells(celldeb, 9) & " : " & Cells(celldeb, 11) & " jours"
     
    'Si MAL et >21 jours, alors il met en bleu gras et ajoute un commentaire avec le nom et le prenom _
    Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
    ElseIf InStr(1, Cells(celldeb, 9).Value, "mal", 1) <> 0 And Cells(celldeb, 11).Value > 21 Then
        Cells(celldeb, 11).Font.ColorIndex = 5
        Cells(celldeb, 11).Font.Bold = True
        Cells(celldeb, 11).AddComment Trim(Cells(celldeb, 4)) & " " & Trim(Cells(celldeb, 5)) & " : " & Chr(10) & Cells(celldeb, 9) & " : " & Cells(celldeb, 11) & " jours"
     
    End If
     
    'Si c'est traité met en noir
    If InStr(1, Cells(celldeb, 11).Value, "Traité", 1) <> 0 Then
        Cells(celldeb, 11).Font.ColorIndex = 2
        Cells(celldeb, 11).Interior.ColorIndex = 1
        Cells(celldeb, 11).Font.Bold = True
        Cells(celldeb, 11).AddComment Trim(Cells(celldeb, 4)) & " " & Trim(Cells(celldeb, 5)) & " : " & Chr(10) & Cells(celldeb, 9) & " : " & Cells(celldeb, 11) & " jours"
    End If
 
Next x
Exit Function
Fin:
Cells(10, 1).Select
End Function


Message édité par SuppotDeSaTante le 06-08-2009 à 14:56:58

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 15:13:24    

Heu...y a un bug ! dans les cellules K21, K23 etc...!!!

Reply

Marsh Posté le 06-08-2009 à 15:17:47    

Et pourquoi tu as surligné en noir !?  
Faut juste laisser, comme quand c'est supérieur, pour "Traité" avec les couleurs de texte (bleu ou rouge) tout simplement !

Reply

Marsh Posté le 06-08-2009 à 15:37:31    

J'ai pas de beug en K21 ou K23 moi...
 
C'est quoi ton beug ??
 
Pour les couleurs ca rajoute pas mal de tests etant donné que la valeur a l'interieur de la meme cellule qui est calculée change... Pis si c'est juste enlever le noir, tu devrais t'en sortir :p
 
Mais bon, il parait qu'is sont bons...
 

Code :
  1. Function lea133
  2. On Error Resume Next
  4. Application.ScreenUpdating = False
  6. Cells(35536, 1).Select
  7. Range(Selection, Selection.End(xlToRight)).Select
  8. Range(Selection, Selection.End(xlUp)).Select
  10. DerLin = ActiveCell.Row
  11. DebLin = 11
  14. 'On vire les commentaires pour les recalculer par la suite. _
  15. ainsi que la couleur et le gras
  16. Range("k:k" ).Select
  17. Selection.ClearComments
  18. Selection.Font.Bold = False
  19. Selection.Font.ColorIndex = 0
  21. For x = 1 To DerLin
  22.     CellSomme = Cells(DebLin, 10)
  23.     celldeb = DebLin
  24.        
  25.     'Booleen pour voir si il y a "traité" ou pas dns la cellule
  26.     If InStr(1, Cells(celldeb, 11), "Traité", 1) <> 0 Then Traite = True
  27.     'Test pour les valeur ayant seulement 1
  28.     If Cells(DebLin + 1, 2) <> "" Then
  29.         Cells(celldeb, 11).Value = CellSomme
  30.     Else
  31.         While Cells(DebLin + 1, 2) = ""
  32.             CellSomme = CellSomme + Cells(DebLin + 1, 10).Value
  33.             DebLin = DebLin + 1
  34.             x = DebLin
  35.             Valeur = True
  36.             If DebLin > DerLin Then GoTo Fin
  37.         Wend
  38.     End If
  39.     If Valeur = True Then
  40.         Cells(celldeb, 11).Value = CellSomme
  41.     End If
  42.    
  43.     'S'il y avat traité, il remet traité a la place du nb, mais mets le nb par la suite dans le commentaire.
  44.     If Traite = True Then
  45.         Cells(celldeb, 11).Value = "Traité " & CellSomme
  46.         Traite = False
  47.     End If
  48.     DebLin = DebLin + 1
  49.     Valeur = False
  50.     'Si At ou ATR et >8 jours, alors il met en rouge gras et ajoute un commentaire avec le nom et le prenom _
  51.     Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
  52.     If (InStr(1, Cells(celldeb, 9).Value, "at", 1) <> 0 Or InStr(1, Cells(celldeb, 9).Value, "atr", 1) <> 0) And CellSomme > 8 Then
  53.         Cells(celldeb, 11).Font.ColorIndex = 3
  54.         Cells(celldeb, 11).Font.Bold = True
  55.         Cells(celldeb, 11).AddComment Trim(Cells(celldeb, 4)) & " " & Trim(Cells(celldeb, 5)) & " : " & Chr(10) & Cells(celldeb, 9) & " : " & Cells(celldeb, 11) & " jours"
  56.    
  57.     'Si MAL et >21 jours, alors il met en bleu gras et ajoute un commentaire avec le nom et le prenom _
  58.     Je passe par instr pour ne pas avoir a gerer les majuscule minuscule
  59.     ElseIf InStr(1, Cells(celldeb, 9).Value, "mal", 1) <> 0 And CellSomme > 21 Then
  60.         Cells(celldeb, 11).Font.ColorIndex = 5
  61.         Cells(celldeb, 11).Font.Bold = True
  62.         Cells(celldeb, 11).AddComment Trim(Cells(celldeb, 4)) & " " & Trim(Cells(celldeb, 5)) & " : " & Chr(10) & Cells(celldeb, 9) & " : " & Cells(celldeb, 11) & " jours"
  63.    
  64.     End If
  65.    
  66. Next x
  67. Application.ScreenUpdating = True
  68. Exit Function
  69. Fin:
  70. Cells(10, 1).Select
  71. Application.ScreenUpdating = True
  72. End Function


Message édité par SuppotDeSaTante le 06-08-2009 à 22:31:17

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 06-08-2009 à 15:39:36    

J'ai edité


Message édité par SuppotDeSaTante le 06-08-2009 à 15:40:56

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed