Aide pour un code VBA archivage

Le 18/07/2018 à 02:36

bonjour je cherche un code vba pour mon probleme suivant

j'ai plusieurs feuille sur un classeur mais pour mon probleme seulement 2 feuilles nous interresse

la feuil2 "Archives"

la feuil3 "Listes factures"

Dans ma feuille listes factures je voudrais que quand dans ma colonne "J", le mot "réglé" aparait (il apparait quand je tape une date de reglement), un petit bouton ou autre apparait dans la colonne "P" qui lui permettrer en un ou double click sur celui ci, d'archiver la ligne complete dans la feuille Archives, tout en supprimant les données de la lignes, mais attention pas les formules qui se trouve dans certaines celulles de cette lignes.

a vos reponses merci

Le 18/07/2018 à 06:36

Bonjour et bienvenue ...

Pour ma part, je conserve tout dans l'onglet d'origine (qui peut comporter 1 million de lignes) et j'utilise un filtre pour n'afficher si besoin que les opérations non "réglées". Cela permet aussi ensuite de faire des synthèses sur la totalité des opérations.

Le 19/07/2018 à 00:09

Bonjour et merci de ta réponse c'est ce que je fesai au début mais mon boss souhaiterai avoir cette feuille avec toutes les factures réglées. Moi je suis qu'un employé jexecute ... si tu as la solution à mon problème je suis preneur.

De plus j'ai vu que c'était possible car j'ai trouver une macro ou vba sur un forum et je n'arrive pas à l'adapter à mon classeur.

Le 19/07/2018 à 06:11

Alors en faisant un filtre avancé avec copie dans une autre feuille tu auras toutes les factures réglées.

Donne un extrait anonymisé de ton fichier.

Le 19/07/2018 à 12:16

Bonjour,

Alors dans la feuille "Liste factures" il faut que tu mette le code ci dessous :

Option Explicit

Dim x, y, PosG, PosH, Longueur, Hauteur As Integer

'Vérification des instructions
Private Sub Worksheet_Change(ByVal Target As Range)
    'Connaitre l'emplacement de la cellule
    y = Target.Row
    x = Target.Column

    'Vérifier si on rempli les contraites
    If x = 9 And Cells(y, 10) = "réglé" Then

        'Sélection du de l'emplacement du bouton à créer
        'Création du bouton pour archiver

        'Détermination de la position de la cellule P
        ActiveSheet.Cells(y, 16).Select

        'Récupération de ces info pour le bouton
        With Selection
            PosG = .Left
            PosH = .Top
            Hauteur = .Height
            Longueur = .Width
        End With

         With ActiveSheet.Buttons
           .Add(PosG, PosH, Longueur, Hauteur).Select
         End With        

         With Selection
            'routine associée
           .OnAction = "archive"
           'Text du bouton
           .Caption = "Archiver"
           ''champ pour récupérer les info de sa position
           .Name = ActiveCell.Address(ReferenceStyle:=xlR1C1)
         End With

         ActiveSheet.Cells(y + 1, x).Select

    End If

End Sub

Et ensuite tu créer un nouveau module pour déclarer la routine qui permet de déplacer ta ligne dans archive :

Option Explicit

Dim btn As String

Sub archive()

    'savoir quel est la ligne à archiver
    btn = Application.Caller

    'déterminer les coordonnées du bouton
    For i = 2 To Len(btn)
        If Mid(btn, i, 1) = "C" Then
            y = CInt(Mid(btn, 2, i - 2))
            x = CInt(Mid(btn, i + 1, Len(btn) - i))
            Exit For
        End If
    Next i

    'Couper ligne et la coller sur la dernière ligne du classeur archive
    ActiveWorkbook.Sheets("Listes factures").Rows(y).Select
    Selection.Copy
    ActiveWorkbook.Sheets("Archives").Activate
    ActiveWorkbook.Sheets("Archives").Rows(ActiveSheet.UsedRange.Rows.Count + 1).Select
    ActiveWorkbook.Sheets("Archives").Paste

    'Supprimer la colonne du bouton
    ActiveWorkbook.Sheets("Archives").Columns(x).Delete

    ActiveWorkbook.Sheets("Listes factures").Activate
    ActiveWorkbook.Sheets("Listes factures").Rows(y).Delete Shift:=xlUp
    ActiveWorkbook.Sheets("Listes factures").Cells(y, 10).Select

End Sub

Et voici Normalement ça devrait marcher.

Bonne continuation

Le 19/07/2018 à 13:27

Valc a écrit :
Bonjour,
Alors dans la feuille "Liste factures" il faut que tu mette le code ci dessous :
Et voici Normalement ça devrait marcher.
Bonne continuation

Balaise ! et tout ceci sans le fichier du demandeur ...

Le 19/07/2018 à 17:09

merci valc pour le code

juste un petit probleme je te laisse voir en PJ

si tu as le temps d'y jeter un oeil

merci d'avance

Le 20/07/2018 à 08:01

Bonjour,

J'ai oublié de déclarer ce variable :

Dans Module :

Option Explicit

Dim btn As String
Dim i, x, y as integer

Sub archive()

    'savoir quel est la ligne à archiver
    btn = Application.Caller

    'déterminer les coordonnées du bouton
    For i = 2 To Len(btn)
        If Mid(btn, i, 1) = "C" Then
            y = CInt(Mid(btn, 2, i - 2))
            x = CInt(Mid(btn, i + 1, Len(btn) - i))
            Exit For
        End If
    Next i

    'Couper ligne et la coller sur la dernière ligne du classeur archive
    ActiveWorkbook.Sheets("Listes factures").Rows(y).Select
    Selection.Copy
    ActiveWorkbook.Sheets("Archives").Activate
    ActiveWorkbook.Sheets("Archives").Rows(ActiveSheet.UsedRange.Rows.Count + 1).Select
    ActiveWorkbook.Sheets("Archives").Paste

    'Supprimer la colonne du bouton
    ActiveWorkbook.Sheets("Archives").Columns(x).Delete

    ActiveWorkbook.Sheets("Listes factures").Activate
    ActiveWorkbook.Sheets("Listes factures").Rows(y).Delete Shift:=xlUp
    ActiveWorkbook.Sheets("Listes factures").Cells(y, 10).Select

End Sub

Le 20/07/2018 à 17:15

bonjour Valc

merci de te démener pour trouver mon code, mais encore un petit soucis