Calcul de date

mir.kan Messages postés 181 Statut Membre -  
mir.kan Messages postés 181 Statut Membre -
Bonjour,
J'aimerais avoir un code en vba qui dès qu'il me reste 5 mois avant ma date de fin validité(qui sera donnée) me bascule toutes mes données vers un autre fichier.

Merci d'avance

3 réponses

  1. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
     
    Bonjour,

    Essaies :
    Option Private Module
    Option Explicit
    
    Public Sub code()
    Dim d As Date
      ' Date qui sera donnée
      d = #6/14/2016#   ' mm/jj/aaaa
      ' Code qui bascule toutes les données vers un autre fichier
      ' dès qu'il reste 5 mois avant la date donnée
      If EstTempsDeBasculerLesDonnées(d) Then Call BasculerLesDonnées
    End Sub
    
    Private Function EstTempsDeBasculerLesDonnées(d As Date) As Boolean
    ' Test faut-t-il bascuker les données ?
      EstTempsDeBasculerLesDonnées = DateDiff("m", d, Now - Day(d) + 1) >= 5
    End Function
    
    Private Sub BasculerLesDonnées()
    ' Basculement des données
      MsgBox "Basculement des données à développer :" & vbCrLf & _
             "Toi seul connait leur emplacement et leur destination."
    End Sub

    0
    1. mir.kan Messages postés 181 Statut Membre
       
      Merci Patrice. Je suis entrain de l'essayer.

      Est ce possible de mettre un code couleur dans une colonne donnée à chaque basculement .Je m'explique si il reste 5mois avant la date de fin, je met le champ de ma colonne 6 du fichier où j'ai basculé mes données en vert et si il reste 3 mois je le met en orange?

      Merci d'avance
      0
    2. mir.kan Messages postés 181 Statut Membre
       
      Dim LigneEnLecture As Integer
      'Affectation du numéro de la ligne de début des données à la variable LigneEnLecture
      LigneEnLecture = 7
      'Déclaration de la variable DateDeFinalisation de type Date
      Dim DateDeFinalisation As Date
      'Déclaration de la variable DateDeFinalisation de type Date
      Dim DateAujourdhui As Date
      'Affection à la variable DateAujourdhui à la date d'aujourd'hui
      DateAujourdhui = Now
      'Cette variable représente le numéro de la ligne où finit le contenu des données (fichier Plan )
      Dim LigneFinDonnees As Long
      LigneFinDonnees = LesPlans.[A1048576].End(xlUp).Row
      'On parcours l'ensemble des lignes contenant des entrées
      While (LigneEnLecture <= LigneFinDonnees)
      'Sélection de la feuille "Plans" du classeur de gestion
      LesPlans.Activate
      'Affection à la variable DateDeFinalisation la date se trouvant dans la colonne Date Finalisation
      With Cells(LigneEnLecture, 6)
      If IsDate(.Value) Then
      DateDeFinalisation = .Value
      Else
      'Si la colonne n'a pas un format correct de date
      DateDeFinalisation = Now
      End If
      End With

      If (Cells(LigneEnLecture, 40) = "Oui" _


      voici mon code je sais pas exactement où intégrer le votre.Est ce que c'est de le mettre après if?
      0
  2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
     
    Bonjour,

    A mauvaise question : mauvaise réponse !!!

    Le code que je t'ai donné répond à : « dès qu'il me reste 5 mois avant ma date de fin validité(qui sera donnée) me bascule toutes mes données vers un autre fichier »

    Mais, si je comprends bien ton morceau de code, tu voudrais basculer uniquement les lignes pour lesquelles il reste moins de 5 mois ???

    Pour répondre il faudrait le code complet.

    Quelques remarques sur ce morceau de code :
    - Pour plus de clarté, on déclare toutes les variables en début de porcédure
    - Il ne faut pas utiliser Select et Activate (sauf si c'est indispensable).
    Par exemple :
    Sub TonCode()
    'Déclaration des variables
    Dim LigneEnLecture As Integer
    Dim DateDeFinalisation As Date
    Dim DateAujourdhui As Date
    Dim LigneFinDonnees As Long
        'Affectation du numéro de la ligne de début des données à la variable LigneEnLecture
        LigneEnLecture = 7
        'Affection à la variable DateAujourdhui à la date d'aujourd'hui
        DateAujourdhui = Now
        'Affectation du numéro de la ligne où finit le contenu des données (fichier Plan )
        LigneFinDonnees = LesPlans.[A1048576].End(xlUp).Row
        'On parcours l'ensemble des lignes contenant des entrées
        While (LigneEnLecture <= LigneFinDonnees)
            'Affection à la variable DateDeFinalisation la date se trouvant dans la colonne Date Finalisation
            With LesPlans.Cells(LigneEnLecture, 6)
               If IsDate(.Value) Then
                   DateDeFinalisation = .Value
               Else
                   'Si la colonne n'a pas un format correct de date
                   DateDeFinalisation = Now
               End If
            End With
    
    0
    1. mir.kan Messages postés 181 Statut Membre
       
      Bonjour;

      j'ai essayé de le faire et ça marche

      .Mais J'aimerais aussi ajouter dans mon code des codes couleurs. En faite j'ai déjà crée un code archivage qui m'archive toutes les lignes qui sont à 5 mois avant l'échéance dans un classeur fermé. Chose faite. A partir de ce code,
      j'aimerais à chaque archivage qu'il me met ma cellule 6 de la feuille 1 de mon classeur fermé en vert et en orange si on est à 3 mois avant l'échéance.

      Est ce possible?
      merci d'avance
      0
  3. mir.kan Messages postés 181 Statut Membre
     
    LigneEnLecture = 7
    'Déclaration de la variable DateDeFinalisation de type Date
    Dim DateDeFinalisation As Date
    'Déclaration de la variable DateDeFinalisation de type Date
    Dim DateAujourdhui As Date
    'Affection à la variable DateAujourdhui à la date d'aujourd'hui
    DateAujourdhui = Now
    'Cette variable représente le numéro de la ligne où finit le contenu des données (fichier Plan)
    Dim LigneFinDonnees As Long
    'Affectation du numéro de la ligne où termine le contenu des données à la variable FinDonnees
    LigneFinDonnees = LesPlans.[A1048576].End(xlUp).Row
    'On parcours l'ensemble des lignes contenant des entrées
    While (LigneEnLecture <= LigneFinDonnees)
    'Sélection de la feuille "Plans" du classeur de gestion
    LesPlans.Activate
    'Affection à la variable DateDeFinalisation la date se trouvant dans la colonne Date Finalisation
    With Cells(LigneEnLecture, 6)
    If IsDate(.Value) Then
    DateDeFinalisation = .Value
    Else
    'Si la colonne n'a pas un format correct de date
    DateDeFinalisation = Now
    End If
    End With

    If (Cells(LigneEnLecture, 40) = "Oui" _
    And DateDiff("m", DateAujourdhui, DateDeFinalisation) = 5) Then
    'Déclaration de la variable LigneFinDonneesArchive de Type Long
    Dim LigneFinDonneesArchive As Long
    'Déclaration de la variable LigneFinDonneesArchive de Type Long
    Dim LigneFinDonneesArchiveSuivisVisiteSignature As Long
    'Sélection de la feuille "Plans" du classeur de gestion
    LesPlans.Activate
    'On sélectionne la ligne à archiver, cad LigneEnLecture
    LesPlans.Rows(LigneEnLecture).Select
    'Copie de la ligne sélectionnée
    Selection.Copy
    'Affectation du bon classeur
    Set ClasseurPlansSignesArchives = Application.Workbooks.Open("\\mv0\Stag\Sta\projet\Automatisation BDD PP\Documents\Développement\Futur Environnement\Gestion des Plans .xlsm")
    'Ouverture du classeur où seront collées les données de la ligne sélectionnée
    ClasseurPlansSignesArchives.Activate
    'Sélection de la feuille "Plans" du classeur ouvert
    ClasseurPlansSignesArchives.Sheets("Plans ").Activate
    'Affectation du numéro de la ligne où finit le contenu des données à la variable NouvelleLigneDebutDonnees
    LigneFinDonneesArchive = ClasseurPlansSignesArchives.Sheets("Plans").[A1048576].End(xlUp).Row
    'Selection de la ligne où sera copiée l'entrée à archiver
    ClasseurPlansSignesArchives.Sheets("Plans").Rows(LigneFinDonneesArchive + 1).Select
    'Puis on colle le tout sur la fauille
    Selection.PasteSpecial


    Voici le code
    0