Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2782 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  excel...comment faire !

 


 Mot :   Pseudo :  
 
 Page :   1  2
Page Précédente
Auteur Sujet :

excel...comment faire !

n°1910357
lea133
Posté le 30-07-2009 à 16:00:14  profilanswer
 

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

mood
Publicité
Posté le 30-07-2009 à 16:00:14  profilanswer
 

n°1910360
lea133
Posté le 30-07-2009 à 16:02:29  profilanswer
 

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

n°1910369
lea133
Posté le 30-07-2009 à 16:21:53  profilanswer
 

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 !
 

n°1910596
lea133
Posté le 31-07-2009 à 11:26:48  profilanswer
 

personne a une idée !?

n°1910604
SuppotDeSa​Tante
Aka dje69r
Posté le 31-07-2009 à 12:41:58  profilanswer
 

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 !
n°1910869
SuppotDeSa​Tante
Aka dje69r
Posté le 01-08-2009 à 00:40:33  profilanswer
 

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


---------------
Soyez malin, louez entre voisins !
n°1911862
lea133
Posté le 05-08-2009 à 10:37:48  profilanswer
 

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

n°1911889
_xme_
Posté le 05-08-2009 à 11:13:15  profilanswer
 

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 ^^

n°1912020
SuppotDeSa​Tante
Aka dje69r
Posté le 05-08-2009 à 16:28:42  profilanswer
 

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
  6. DerLin = ActiveCell.Row
  7. DebLin = 11
  8. For x = 1 To DerLin
  9.     CellSomme = Cells(DebLin, 10)
  10.     CellDeb = DebLin
  11.     While Cells(DebLin + 1, 2) = ""
  12.         CellSomme = CellSomme + Cells(DebLin + 1, 10).Value
  13.         DebLin = DebLin + 1
  14.         x = DebLin
  15.         Valeur = True
  16.         If DebLin > DerLin Then Exit Function
  17.     Wend
  18.    
  19.     If Valeur = True Then Cells(CellDeb, 11).Value = CellSomme
  20.     DebLin = DebLin + 1
  21.     Valeur = False
  22. Next x
  23. 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 !
n°1912036
lea133
Posté le 05-08-2009 à 16:55:18  profilanswer
 

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

mood
Publicité
Posté le 05-08-2009 à 16:55:18  profilanswer
 

n°1912047
lea133
Posté le 05-08-2009 à 17:02:30  profilanswer
 

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 !

n°1912177
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 09:43:59  profilanswer
 

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 !
n°1912212
lea133
Posté le 06-08-2009 à 10:28:36  profilanswer
 

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 ?!

n°1912233
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 11:11:14  profilanswer
 

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 !
n°1912236
lea133
Posté le 06-08-2009 à 11:23:32  profilanswer
 

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

n°1912237
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 11:26:17  profilanswer
 

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


---------------
Soyez malin, louez entre voisins !
n°1912242
lea133
Posté le 06-08-2009 à 11:30:42  profilanswer
 

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

n°1912243
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 11:31:31  profilanswer
 

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 !
n°1912244
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 11:32:12  profilanswer
 

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 !
n°1912245
lea133
Posté le 06-08-2009 à 11:33:45  profilanswer
 

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 !

n°1912247
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 11:34:29  profilanswer
 

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 !
n°1912249
lea133
Posté le 06-08-2009 à 11:35:28  profilanswer
 

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 !

n°1912251
lea133
Posté le 06-08-2009 à 11:39:30  profilanswer
 

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

n°1912253
lea133
Posté le 06-08-2009 à 11:41:30  profilanswer
 

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 !

n°1912255
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 11:42:49  profilanswer
 

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 !
n°1912258
lea133
Posté le 06-08-2009 à 11:44:14  profilanswer
 

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

n°1912264
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 11:50:39  profilanswer
 

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 !
n°1912266
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 11:54:15  profilanswer
 

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


---------------
Soyez malin, louez entre voisins !
n°1912271
lea133
Posté le 06-08-2009 à 11:58:22  profilanswer
 

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 !

n°1912273
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 12:00:49  profilanswer
 

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


---------------
Soyez malin, louez entre voisins !
n°1912278
lea133
Posté le 06-08-2009 à 12:06:31  profilanswer
 

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...

n°1912279
_xme_
Posté le 06-08-2009 à 12:09:04  profilanswer
 

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

n°1912281
lea133
Posté le 06-08-2009 à 12:11:53  profilanswer
 

LOL _xme_ !

n°1912283
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 12:13:40  profilanswer
 

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 !
n°1912286
lea133
Posté le 06-08-2009 à 12:15:34  profilanswer
 

OK pas de problème !
Bon ap
 
Merci

n°1912389
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 14:50:49  profilanswer
 

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 !
n°1912403
lea133
Posté le 06-08-2009 à 15:13:24  profilanswer
 

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

n°1912404
lea133
Posté le 06-08-2009 à 15:17:47  profilanswer
 

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 !

n°1912423
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 15:37:31  profilanswer
 

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


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

---------------
Soyez malin, louez entre voisins !
n°1912426
SuppotDeSa​Tante
Aka dje69r
Posté le 06-08-2009 à 15:39:36  profilanswer
 

J'ai edité


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

---------------
Soyez malin, louez entre voisins !
mood
Publicité
Posté le   profilanswer
 

 Page :   1  2
Page Précédente

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  excel...comment faire !

 

Sujets relatifs
Catcher une alerte dans une macro excelMacro Excel : tableau dynamique
[EXCEL] Liste clients -> recherche géographiqueBouton Excel associé à une macro
[VBA][Excel][Word] Redimensionner Tableau[ VBA EXCEL > CALC ]
[VBA Excel] Importer ldif dans excel[VBA Excel] garder la mise en forme dans une textbox [RESOLU]
[RESOLU] [VBS] copier uniquement les lignes filtrées sous ExcelExcel: boucle pour plusieurs commandbutton
Plus de sujets relatifs à : excel...comment faire !


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR