veriti site des amis d'excel

EXCEL ANNEE 2017

L'heure est venue de vous presenter

Une excel et bonne annee 2017 !

De la part de toute l equipe de VeriTi

Bienvenue

sur le site des amis d'Excel

excel.veriti.net ou fr

Musee

Visitez le "Musee VeriTi" 24h/24 - 7j/7, des "pepites" vous y attendent

Voir la suite

Hommage

Thierry POURTIER alias 'Ti'
s'en est alle brutalement le samedi 13 novembre 2010...

Voir la suite

Historique

Juillet 2013 : A l'occasion du 10eme anniversaire de VeriTi, j'ai décide de réparer et de remettre en ligne le site, avec une nouvelle version plus structurée tout en gardant les mêmes fichiers Excel

Voir la suite

Membre

+ Enregistrement

Re : Modification Macro

Objet : Re : Modification Macro
par BrunoM45 sur 25/11/2013 23:02:00

Bonjour Ntx et bienvenue sur ce forum

Tu peux essayer ce code


Private Sub Workbook_Open()

  Dim DLig As Long, Lig As Long

  Dim sTmp As String, sDate As String, vDate As Date

  Dim EcartJ As Long, EcartM As Long

  Dim Msg As String

  With Worksheets("Model 1")

    DLig = .Range("B" & Rows.Count).End(xlUp).Row

    For Lig = 13 To DLig  ' Pour chaque ligne

      sTmp = .Range("B" & Lig).Value

      ' Vérifier s'il s'agit d'une ligne d'ouverture

      ' Sinon, passer à la ligne suivante

      If InStr(1, sTmp, "Date ouv") = 0 Then GoTo SuiteLig

      ' Récupérer le texte de la date

      sDate = Mid(sTmp, InStr(1, sTmp, "/") - 2, 10)

      ' Convertir en valeur de date

      vDate = DateValue(sDate)

      ' Calculer l'écart en mois

      EcartM = DateDiff("m", vDate, Now)

      ' Selon l'écart

      If EcartM >= 2 And EcartM < 3 Then

        EcartJ = DateDiff("d", vDate, Now)

        Msg = Msg & "Le client  " & .Cells(Lig - 2, 2) & " pour " _

            & ", N°Reg " & .Cells(Lig - 3, 4) & "  atteint  ces 3 mois, dans " & EcartJ & " jours." & Chr(10)

      ElseIf EcartM > 3 Then

        Msg = Msg & "Le client " & .Cells(Lig - 2, 2) & " pour " _

            & ", mat " & .Cells(Lig, 1) & " a dejà atteint  3 mois et  plus  " & Chr(10)

      End If

SuiteLig:

    Next Lig

    MsgBox Msg

  End With

End Sub

A+