Macro-programmée

Bonjour,

Dans le cadre d'une cours je dois réaliser une macro mais mes compétences dans ce domaine sont limitées.

Cette macro, intitulée « miseAJourProcedure », doit comme son nom l’indique,

mettre à jour une procédure (de changer de version, en l’incrémentant de 1). Cela implique que la

ligne correspondante de la procédure doit être copiée (en valeur) et collée dans la nouvelle feuille 3,

intitulée « Archives », dans la première ligne disponible. Ensuite, dans la feuille 2, la version doit être

incrémentée de 1, et la formule permettant de sélectionner les personnes qui doivent suivre cette

formation doit être à nouveau collée sur l’ensemble de la ligne de la procédure (afin de réinitialiser

les valeurs, vu qu’il s’agit d’une nouvelle procédure).

La macro doit être effectuée via un bouton

Manuel,

tu as un bout de code à présenter ?

Bonjour,

Merci pour votre aide

Voici mon début de code

Sub miseajourprocedure()

Dim Procedure As String

Dim Rng As Range

Dim LigneProcedure As Integer

Dim NumeroDeVersion As Integer

Procedure = InputBox("Que voulez-vous mettre à jour ?")

If Trim(Procedure) <> "" Then

With Sheets("Personnel").Range("B:B")

Set Rng = .Find(What:=Procedure, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)

If Not Rng Is Nothing Then

LigneProcedure = Rng.Offset(0, -1)

NumeroDeVersion = Rng.Offset(0, 1).Value

Rng.Offset(0, 1).Value = NumeroDeVersion + 1

MsgBox "Mise à jour de la procédure " + Procedure + " effectuée"

Else

MsgBox "La ligne que vous voulez mettre à jour n'existe pas"

End If

End With

End If

End Sub

Ce code me sert à incrémenter a version de 1 seulement mais cependant, ans ce code il faut que je rajoute un moyen de copier-coller les résultats de mon tableau dans les archives. La ligne qui doit être copier collée doit être la même que celle de la procédure qui est choisie pour la mise à jour par exemple si la procédure QA-SSS-1 est choisie alors seulement celle là doit être copier et collée mais je ne sais pas comment faire. De plus quand ma ligne se mets à jour les formules des cellules sont censées disparaître mais je n'y arrive pas non plus.

capture d ecran 634
LigneProcedure = Rng.Offset(0, -1)

ne donnera pas la ligne mais une cellule, utilise plutôt

LigneProcedure = Rng.row

Indente aussi ton code pour y voir clair ...

Ajoute aussi

option explicit
Option Explicit

Sub miseajourprocedure()

    Dim Procedure As String
    Dim Rng As Range
    Dim LigneProcedure As Integer
    Dim NumeroDeVersion As Integer

    Procedure = InputBox("Que voulez-vous mettre à jour ?")

    If Trim(Procedure) <> "" Then
        With Sheets("Personnel").Range("B:B")
            Set Rng = .Find(What:=Procedure, _
            After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)

            If Not Rng Is Nothing Then

                LigneProcedure = Rng.Row
                NumeroDeVersion = Rng.Offset(0, 1).Value
                Rng.Offset(0, 1).Value = NumeroDeVersion + 1
                MsgBox "Mise à jour de la procédure " + Procedure + " effectuée"

            Else
                MsgBox "La ligne que vous voulez mettre à jour n'existe pas"
            End If
        End With
    End If

End Sub

on verra la suite demain !

As-tu des idées sur comment copier ? comment trouver la dernière ligne dispo de Archives ?

Non pas du tout mais je regarderai et je vous enverrai mon code demain en ce qui concerne le copier coller et trouver la dernière ligne dispo en archive

Merci encore pour votre aide.

Bonjour,

Après des recherches je n'ai finalement rien trouvé pour trouver la dernière ligne et copier coller la ligne voulue.

En effet les seuls codes que j'ai trouvé me propose de sélectionner une ligne à l'avance ou des cellules bien précise or ça doit ce faire automatiquement quand je sélectionne la procédure au début Lorsque je fais la mise à jour.

Les seuls indice que j'ai sont :

Worksheets("Archives").Cells(Rows.Count, "B").End(xlUp).Row + 1

pour trouver la dernière ligne libre et cela pour coller

Worksheets("Personnel").Cells(cRow, Columns.Count).End(xlToLeft).Column

mais je ne sais pas quoi en faire.

Que signifie cRow dans ton exemple ? utilise LigneProcedure

En suivant tes indications, ajoute

    Dim LigneVideArchive As Integer
    Dim DerniereColone As Integer

puis

                LigneVideArchive = Worksheets("Archives").Cells(Rows.Count, "B").End(xlUp).Row + 1
                DerniereColone = Worksheets("Personnel").Cells(LigneProcedure, Columns.Count).End(xlToLeft).Column

pour avoir la ligne vide d'Archives, et la dernière colonne à copier

Maintenant, comment copier en valeur ?

Option Explicit

Sub miseajourprocedure()

    Dim Procedure As String
    Dim Rng As Range
    Dim LigneProcedure As Integer
    Dim NumeroDeVersion As Integer
    Dim LigneVideArchive As Integer
    Dim DerniereColone As Integer

    Procedure = InputBox("Que voulez-vous mettre à jour ?")

    If Trim(Procedure) <> "" Then
        With Sheets("Personnel").Range("B:B")
            Set Rng = .Find(What:=Procedure, _
            After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)

            If Not Rng Is Nothing Then

                LigneProcedure = Rng.Row

                ' incrément du numéro de version
                NumeroDeVersion = Rng.Offset(0, 1).Value
                Rng.Offset(0, 1).Value = NumeroDeVersion + 1

                ' dernière ligne vide
                LigneVideArchive = Worksheets("Archives").Cells(Rows.Count, "B").End(xlUp).Row + 1

                ' dernière colonne à copier
                DerniereColone = Worksheets("Personnel").Cells(LigneProcedure, Columns.Count).End(xlToLeft).Column

                ' ======= IL FAUT MAINTENANT COPIER EN VALEURS ================

                MsgBox "Mise à jour de la procédure " + Procedure + " effectuée"

            Else
                MsgBox "La ligne que vous voulez mettre à jour n'existe pas"
            End If
        End With
    End If

End Sub

Pour copier en valeur j'ai trouvé ceci :

Worksheets("Sheet1").Range("A1:D4").Copy _

destination:=Worksheets("Sheet2").Range("E5")

Je pensais donc la modifié comme ceci :

Worksheets("Personnel").Range("LigneProcedure").Copy _

destination:=Worksheets("Archives").Range("LigneVideArchive")

Mais ça ne fonctionne pas et le débogage mais met le tout en jaune mais je ne sais pas ce que j'ai faux je pensais pouvoir remplacer les cellules par ligneProcedure et ligneVideArchive

Worksheets("Personnel").Range("LigneProcedure").Copy _
destination:=Worksheets("Archives").Range("LigneVideArchive")

LigneProcedure n'est pas le nom d'une cellule, LigneVideArchive non plus, ce sont des valeurs numériques (le n° de la ligne)

Pour copier en valeur, le plus simple est de faire

Worksheets("Archives").Cells(LigneVideArchive,j) = Worksheets("Personnel").cells(LigneProcedure,j)

et faire une boucle sur j pour balayer depuis la première colonne à copier (colonne 2 ?) jusqu'à DerniereColone calculée précédemment

j'ai introduit votre formule mais il est écrit erreur de compilation variable non définie.

De plus, je n'ai pas compris quand vous avez parlé de faire une boucle sur j pour balayer.

Une boucle, c'est ceci :

                For j = 2 To DerniereColone
                    Worksheets("Archives").Cells(LigneVideArchive, j) = Worksheets("Personnel").Cells(LigneProcedure, j)
                Next

Mais il faut aussi déclarer j

Dim j as integer

J'ai vu que tu avais aussi introduit des en-têtes dans archives, en plus avec des cellules fusionnées ! quelle horreur.

Alors ajoute aussi un message pour voir quelle est la première ligne disponible sur Archives, dans une nouvelle procédure par exemple ! Dis moi si c'est ok !!

Sub testlignedisponible()
    Dim LigneVideArchive As Integer
    LigneVideArchive = Worksheets("Archives").Cells(Rows.Count, "B").End(xlUp).Row + 1
    MsgBox LigneVideArchive
End Sub

Ça ne fonctionne pas lorsque je fais la macro pour voir quelle ligne est disponible il me donne toujours la 3 même si elle n'est pas disponible. De plus la ligne viens se copier coller dans la ligne 3 à chaque fois. Je ne sais pas pourquoi.

Ça ne fonctionne pas lorsque je fais la macro pour voir quelle ligne est disponible il me donne toujours la 3 même si elle n'est pas disponible. De plus la ligne viens se copier coller dans la ligne 3 à chaque fois. Je ne sais pas pourquoi.

Hé oui !!

Dans des cellules fusionnées, seule la cellule en haut à gauche est réellement remplie, le reste c'est du vide !

En l'occurence, la macro trouve la ligne 3 car elle est fusionnée avec B2 !!

Ajoute donc un test qui dit que si la macro trouve moins que 5, il faut prendre 5

                ' recopie en valeurs
                If LigneVideArchive < 5 Then LigneVideArchive = 5
                For j = 2 To DerniereColone
                    Worksheets("Archives").Cells(LigneVideArchive, j) = Worksheets("Personnel").Cells(LigneProcedure, j)
                Next

La leçon est qu'il ne faut pas fusionner des cellules, c'est une plaie !

Maintenant tout fonctionne le seul problème est que l'échéance ne se copie colle pas correctement des nombres aléatoires se mettent à la place des dates

Ce ne sont pas des nombres aléatoires ... aujourd'hui nous somme le 43981.

Change le format en date et tu verras.

Une date pour excel est juste un nombre de jours depuis le dimanche 1 janvier 1900

Change le format pour toute la colonne concernée.

Voilà tout fonctionne. Merci beaucoup ! Je pense que sans aide cet exercice aurait été impossible pour moi

Encore merci !

Bonjour je reviens vous posez une dernière question en relisant les consignes de mon travail, je me suis rendu compte que j'avais oublié de faire certaines choses et il y a quelque chose que je n'arrive pas à faire : lorsque je fais la mise à jour procédure normalement quand je modifie une cellule la formule qui se trouvait dans cette même cellules doit se remettre automatiquement mais je ne sais pas comment faire. Je dois utiliser un copier coller ?

Rechercher des sujets similaires à "macro programmee"