Bienvenue sur les forums conseil & création · S'enregistrer
Se connecter automatiquement

Forums » Tableurs et logiciels de gestion (Money, Excel, Open Office...) » CORRECTION MACRO · Envoyer le lien

Répondre à ce sujet

Par AURELIE, le 02 Déc 2006, 12:45 Revenir en haut de page Répondre en citant
Bonjour,
Voilà la macro que j'ai créer.pas de problèmes elle fonctionne.elle calcule bien les differentes zone
J'aimerai ajouter à cette macro une fonction qui me permettrait en plus de voir visuellement (la case serait colorée) toutes les cases ou l'année en cours apparait .
Pouvez vous m'aider
merci d'avance

Code:
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée
'
i = 5

While Cells(i, 1) <> ""

JSN = 0
JSPV = 0

datdebsn = Cells(i, 3)
datfinsn = Cells(i, 4)

datdebspv = Cells(i, 6)
datfinspv = Cells(i, 7)

datdebspp = Cells(i, 9)

datfinsppnorm = DateAdd("yyyy", 20, datdebspp)
datfinsppnorm1 = DateAdd("yyyy", 25, datdebspp)
datfinsppnorm2 = DateAdd("yyyy", 30, datdebspp)


'pas de SPP

If datdebspp = "" Then
Cells(i, 10) = datdebpp
Cells(i, 11) = datdebspp
Cells(i, 12) = datdebspp
End If

' SPP
If datdebspp <> "" Then

'pas de SN, pas de SPV
If datdebsn = "" And datdebspv = "" Then
Cells(i, 10) = datfinsppnorm
Cells(i, 11) = datfinsppnorm1
Cells(i, 12) = datfinsppnorm2
End If


'pas de SN et SPV
If datdebsn = "" And datdebspv <> "" Then
    If datdebspv < datdebspp And datfinspv <= datdebspp Then
    JSPV = DateDiff("d", datdebspv, datfinspv)
    JSN = 0
    End If
    If datdebspv < datdebspp And datfinspv > datdebspp Then
    JSPV = DateDiff("d", datdebspv, datdebspp)
    JSN = 0
    End If
nbjour = -JSPV
Cells(i, 10) = DateAdd("d", nbjour, datfinsppnorm)
Cells(i, 11) = DateAdd("d", nbjour, datfinsppnorm1)
Cells(i, 12) = DateAdd("d", nbjour, datfinsppnorm2)
End If
   
   
'SN et pas de SPV
If datdebsn <> "" And datdebspv = "" Then
    If datdebsn < datdebspp And datfinsn <= datdebspp Then
    JSN = DateDiff("d", datdebsn, datfinsn)
    JSPV = 0
    End If
    If datdebsn < datdebspp And datfinsn > datdebspp Then
    JSN = DateDiff("d", datdebsn, datdebspp)
    JSPV = 0
    End If
nbjour = -JSN
Cells(i, 10) = DateAdd("d", nbjour, datfinsppnorm)
Cells(i, 11) = DateAdd("d", nbjour, datfinsppnorm1)
Cells(i, 12) = DateAdd("d", nbjour, datfinsppnorm2)
End If

'SN et SPV
If datdebsn <> "" And datdebspv <> "" Then
    'SN avant SPV sans chevauchement
If datfinsn <= datdebspv Then
    If datdebspp <= datfinspv Then
        JSN = DateDiff("d", datdebsn, datfinsn)
        JSPV = DateDiff("d", datdebspv, datdebspp)
    End If
    If datdebspp > datfinspv Then
        JSN = DateDiff("d", datdebsn, datfinsn)
        JSPV = DateDiff("d", datdebspv, datfinspv)
    End If
nbjour = -JSN - JSPV
Cells(i, 10) = DateAdd("d", nbjour, datfinsppnorm)
Cells(i, 11) = DateAdd("d", nbjour, datfinsppnorm1)
Cells(i, 12) = DateAdd("d", nbjour, datfinsppnorm2)
End If
   
    'SN avant SPV avec chevauchement
If datfinsn >= datdebspv And datdebsn < datdebspv Then
    If datdebspp <= datfinspv Then
        JSN = DateDiff("d", datdebsn, datdebspv)
        JSPV = DateDiff("d", datdebspv, datdebspp)
    End If
    If datdebspp > datfinspv Then
        JSN = DateDiff("d", datdebsn, datdebspv)
        JSPV = DateDiff("d", datdebspv, datfinspv)
    End If
nbjour = -JSN - JSPV
Cells(i, 10) = DateAdd("d", nbjour, datfinsppnorm)
Cells(i, 11) = DateAdd("d", nbjour, datfinsppnorm1)
Cells(i, 12) = DateAdd("d", nbjour, datfinsppnorm2)
End If
   
     'SPV avant SN sans chevauchement
If datfinspv <= datdebsn Then
    If datdebspp <= datfinsn Then
        JSN = DateDiff("d", datdebsn, datdebspp)
        JSPV = DateDiff("d", datdebspv, datfinspv)
    End If
    If datdebspp > datfinsn Then
        JSN = DateDiff("d", datdebsn, datfinsn)
        JSPV = DateDiff("d", datdebspv, datfinspv)
    End If
nbjour = -JSN - JSPV
Cells(i, 10) = DateAdd("d", nbjour, datfinsppnorm)
Cells(i, 11) = DateAdd("d", nbjour, datfinsppnorm1)
Cells(i, 12) = DateAdd("d", nbjour, datfinsppnorm2)
End If

    'SPV avant SN avec chevauchement
If datfinspv >= datdebsn And datdebspv < datdebsn Then
    If datdebspp <= datfinsn Then
        JSN = DateDiff("d", datdebsn, datdebspp)
        JSPV = DateDiff("d", datdebspv, datdebsn)
    End If
    If datdebspp > datfinsn Then
        JSN = DateDiff("d", datdebsn, datfinsn)
        JSPV = DateDiff("d", datdebspv, datdebsn)
    End If
nbjour = -JSN - JSPV
Cells(i, 10) = DateAdd("d", nbjour, datfinsppnorm)
Cells(i, 11) = DateAdd("d", nbjour, datfinsppnorm1)
Cells(i, 12) = DateAdd("d", nbjour, datfinsppnorm2)
End If
   
    'SN pendant SPV
If datdebsn >= datdebspv And datfinsn <= datfinspv Then
    If datdebspp <= datfinspv Then
        JSN = 0
        JSPV = DateDiff("d", datdebspv, datdebspp)
    End If
    If datdebspp > datfinspv Then
        JSN = 0
        JSPV = DateDiff("d", datdebspv, datfinspv)
    End If
nbjour = -JSN - JSPV
Cells(i, 10) = DateAdd("d", nbjour, datfinsppnorm)
Cells(i, 11) = DateAdd("d", nbjour, datfinsppnorm1)
Cells(i, 12) = DateAdd("d", nbjour, datfinsppnorm2)
End If

    'SPV pendant SN
If datdebspv >= datdebsn And datfinspv <= datfinsn Then
    If datdebspp <= datfinsn Then
        JSPV = 0
        JSN = DateDiff("d", datdebsn, datdebspp)
    End If
    If datdebspp > datfinsn Then
        JSPV = 0
        JSN = DateDiff("d", datdebsn, datfinsn)
    End If
nbjour = -JSN - JSPV
Cells(i, 10) = DateAdd("d", nbjour, datfinsppnorm)
Cells(i, 11) = DateAdd("d", nbjour, datfinsppnorm1)
Cells(i, 12) = DateAdd("d", nbjour, datfinsppnorm2)
End If

End If 'SN SPV
Cells(i, 5) = JSN
Cells(i, 8) = JSPV

End If  'SPP
i = i + 1

Wend

End Sub
Par Cédric, le 02 Déc 2006, 13:52 Revenir en haut de page Répondre en citant
Salut,

Tu veux dire sur TOUTES les cellules, ou seulement celles d'une colonne spécifique?!

Apparemment tu te démerdes pas mal avec les macros donc pour déterminer quelle cellule modifier, ça devrait être bon?! Tu ne cherches certainement que le code permettant de mettre en forme la cellule ?

Bon, tu fais déjà une boucle sur tes lignes, il ne te reste plus qu'à comparer l'année avec l'année en cours. Par exemple, tu ajoutes dans ta boucle:

Code:
    If Year(Cells(i, 1)) = Year(Now) Then
        ' Mettre le fonds en couleur
        Cells(i, 1).Interior.ColorIndex = 36
        Cells(i, 1).Interior.Pattern = xlSolid
        ' mettre en gras
        Cells(i, 1).Font.Bold = True
    End If


Est-ce que ça te convient ?
Par AURELIE, le 02 Déc 2006, 14:10 Revenir en haut de page Répondre en citant
Cédric a écrit:
Salut,

Tu veux dire sur TOUTES les cellules, ou seulement celles d'une colonne spécifique?!

Apparemment tu te démerdes pas mal avec les macros donc pour déterminer quelle cellule modifier, ça devrait être bon?! Tu ne cherches certainement que le code permettant de mettre en forme la cellule ?

Bon, tu fais déjà une boucle sur tes lignes, il ne te reste plus qu'à comparer l'année avec l'année en cours. Par exemple, tu ajoutes dans ta boucle:

Code:
    If Year(Cells(i, 1)) = Year(Now) Then
        ' Mettre le fonds en couleur
        Cells(i, 1).Interior.ColorIndex = 36
        Cells(i, 1).Interior.Pattern = xlSolid
        ' mettre en gras
        Cells(i, 1).Font.Bold = True
    End If


Est-ce que ça te convient ?


salut cedric,
merci pour ton aide.
en fait je voudrai qu'il fasse un controle sur les cellules de 3 colonnes.
je voudrai toutes les cellules du 04/12/2006 au 04/12/2007 par ex
merci
Par Cédric, le 03 Déc 2006, 00:38 Revenir en haut de page Répondre en citant
Dans ce cas tu remplaces juste

Code:
If Year(Cells(i, 1)) = Year(Now) Then


Par :

Code:
If (Cells(i, 1) >= DateSerial(2006, 12, 4) And Cells(i, 1) <= DateSerial(2007, 12, 4)) Then


Voire si tu veux que les années soient modifiées automatiquement tous les ans:

Code:
If (Cells(i, 1) >= DateSerial(Year(Now), 12, 4)
  And Cells(i, 1) <= DateSerial(Year(Now) + 1, 12, 4)) Then
Par Cédric, le 03 Déc 2006, 12:31 Revenir en haut de page Répondre en citant
Salut Aurélie,

Peux-tu cliquer sur "Répondre" plutôt que sur "nouveau message" (puisqu'il s'agit du même sujet)... ça évite de perdre le fil du message

Aurélie a écrit:
salut cedric

merci pour tes réponses
j'ai esssayé comme tu m'as dit, j'ai tjs une erreur de syntaxe
ci joint ligne.
merci bcp...

Code:
If (Cells(i, 10)) >= DateSerial(2006,12,4)And Cells(i,10)<=DateSerial(2007,12,4)) Then
'mettre le fond en couleur
Cells(i, 10).Interior.ColorIndex = 35
Cells(i, 10).Interior.Pattern = xlSolid
'mettre en gras
Cells(i, 10).Font.Bold = True
End If


Tu as rajouté une parenthèse (fermante) en trop au IF:

Aurélie a écrit:
If (Cells(i, 10)) >=
Par AURELIE, le 03 Déc 2006, 20:25 Revenir en haut de page Répondre en citant
Bonjour Cédric,
Je ne comprends pas, j'ai bien borne les dates du 4/12/2006 au 04/12/2007.mais il me selectionne tout de meme l'anne 2006 en entiere.

Code:
If (Cells(i, 10) >= DateSerial(2006, 12, 4) And Cells(i, 10) <= DateSerial(2007, 12, 4)) Then
'mettre le fond en couleur
Cells(i, 10).Interior.ColorIndex = 35
Cells(i, 10).Interior.Pattern = xlSolid
'mettre en gras
Cells(i, 10).Font.Bold = True
End If
Par Cédric, le 04 Déc 2006, 09:52 Revenir en haut de page Répondre en citant
Pas normal... Rolling Eyes
Tu es sûre d'avoir retiré le morceau de code que tu as ajouté précédemment (If Year(Cells(i, 1)) = Year(Now) Then...) ?

NB: si tu modifies l'intervalle de dates pour la recherche, les cellules déjà mises en forme (par une recherche précédente) le resteront! Même si elles ne correspondent plus à la nouvelle recherche!

Solution:

Citation:
If (on teste les dates) Then
' OK, on met en forme
Else
' Ne correspond pas (ou plus), on efface la mise en forme
End If


Soit:

Code:
If (Cells(i, 10)) >= DateSerial(2006,12,4)And Cells(i,10)<=DateSerial(2007,12,4)) Then
  Cells(i, 10).Interior.ColorIndex = 35
  Cells(i, 10).Interior.Pattern = xlSolid
  Cells(i, 10).Font.Bold = True
Else
  Cells(i, 10).Interior.ColorIndex = xlNone
  Cells(i, 10).Font.Bold = False
End If
Par AURELIE, le 04 Déc 2006, 11:08 Revenir en haut de page Répondre en citant
salut cedric,
merci bcp pour ton aide, tout est ok.
bonne journée
Par Cédric, le 08 Déc 2006, 17:43 Revenir en haut de page Répondre en citant
Bonne journée... et bon week-end Wink

A bientôt,
Cédric

Répondre à ce sujet

Forums » Tableurs et logiciels de gestion (Money, Excel, Open Office...) » CORRECTION MACRO · Envoyer le lien

Forums phpbb modifié par Cédric Michel © 2006 Conseil & Création