Soucis pour execution automatique d'une macro Résolu/Fermé

Question

Bonjour à tous.

Je viens vers vous pour vous demander un coup de main.

J'aimerais réaliser une macro qui s'execute automatiquement en arrière plan.


J'ai testé avec Private Sub Worksheet_SelectionChange(ByVal Target As Range) mais ça colle pas. 

En fait, ma macro procède ainsi. 

Dans un tableau Excel à 4 colonnes (Nom de l'entreprise, secteur, montant, date de signature), je vérifie que la somme des montants n'excède pas une valeur fixée dans une autre cellule préalablement remplie.

Tant que ça n'atteint pas cette somme, on laisse l'utilisateur remplir les lignes du tableau. Quand l'utilisateur saisie un montant qui fait dépasser la valeur limite, on l'averti qu'il dépasse ce montant grâce à une msg box indiquant la différence entre le montant limite et le total des montants qu'il a saisi. Une fois fait, on coupe la dernière ligne qu'il a saisi et on la colle dans un tableau de mise en attente.

Avec Private Sub Worksheet_SelectionChange(ByVal Target As Range), le problème est que la msg box pop à chaque fois que la macro apporte des changements dans la feuille... ce qui n'est pas pratique du tout.

Comment faire pour qu'une fois le dépassement repéré, la macro s'execute sans que la msg box pop plusieurs fois pendant l'action ?

si quelqu'un sait me dire comment mettre une pièce jointe, je pourrai mettre mon tableau pour vous montrer.

Par ailleurs, mais là c'est encore autre chose, je n'arrive pas à écrire la deuxième partie de la macro (celle qui fait couper la ligne et la coller dans un second tableau. J'arrive à faire le couper mais après, je bloque.

Si vous pouvez m'aider, je vous en serai reconnaissant.

Merci à vous,

Binouses.

ps: voici la macro que j'ai faite à cette heure ci==>


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim MaLigne, somme, depassement, Autirage As Variant

MaLigne = Range("A4").End(xlDown).Address
MaLigne = Range(MaLigne).Row


somme = Range("B2").Value
Autirage = Range("B1").Value



depassement = somme - Autirage

If somme > Autirage Then
    MsgBox ("Attention, vous dépassez votre autorisation de tirage de " & depassement & " euros!")

    Range("A" & MaLigne).Select
    ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Cut
    
     Maligne2 = Range("A24").End(xlDown).Address
     Maligne2 = Range(Maligne2).Row
     
     Maligne3 = Maligne2 + 1 (à partir de là, ça coince)
     
     Range("A" & Maligne3).Select
     ActiveSheet.Paste
     
    
End If

End Sub

Polux31 · Answer

Bonjour,

Apparemment les variables somme et Autirage sont des valeurs fixes (B2 et B1). Donc B2 est toujours supérieur à B1 et ta condition:
"If somme > Autirage Then" est toujours vraie.

Pour joindre un document, tu peux le faire par https://www.cjoint.com/, tu viens mettre ensuite le lien que te donne le site ici.

;o)

Binouses · Answer

Salut Polux. Non, on regarde la valeur dans ces deux cellules.  donc ça, ça pose pas de problème :D.

Merci pour le lien, je vais mettre mon tableau.

Polux31 · Answer

Non, on regarde la valeur dans ces deux cellules. donc ça, ça pose pas de problème :D.  Ôo ...

Et bien si, le problème est là justement ... parce que la valeur ne change pas et donc au changement suivant la condition est toujours vraie. :DDDD

Binouses · Answer

ben si elle change cette valeur... à chaque fois qu'on rajoute/supprime un contrat.

Ou alors je vois pas où tu veux en venir. Peux tu m'expliquer ?

sinon, voila la maquette du fichier:

	https://www.cjoint.com/?byugMjCy7Q

et voilà, lien modifié. désolé de l'erreur.

Polux31 · Answer

Oups c'est un format .xlsx ...

Peux tu remettre le fichier au format Excel 2003 stp ?

Merci.

Binouses · Answer

lien mis à jour au dessus. Dsl Polux31

Polux31 · Answer

Il n'y a pas le code .... pas grave je copie/colle celui que tu as mis dans ton 1er post.

Ben si elle change cette valeur... à chaque fois qu'on rajoute/supprime un contrat Oui. Mais ta macro elle fonctionne à chaque fois qu'il se passe un évènement dans une cellule. Et il y en a dans ton code xDDDD

Je regarde un peu ton fichier et je te donne une réponse.

Polux31 · Answer

Voilà, copie colle se code à la place de l'autre :

J'ai changé l'évènement Worksheet_SelectionChange par Worksheet_Change qui me semble plus approprié.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaLigne, somme, depassement, Autirage As Variant

If Target.Column <> 3 Then Exit Sub 'Si on n'est pas sur la colonne C, on sort de la procédure
If Target.Text = "" Then Exit Sub 'idem si la cellule est vide.

somme = Range("B2").Value
Autirage = Range("B1").Value

depassement = somme - Autirage

If somme > Autirage Then
    rep = MsgBox("Attention, vous dépassez votre autorisation de tirage de " & depassement & " euros!" & vbCrLf _
            & "Voulez-vous continuer ?", vbYesNo)
    If rep = vbNo Then
        Exit Sub
    Else

    MaLigne = Range("A4").End(xlDown).Address
    MaLigne = Range(MaLigne).Row
    
    Range("A" & MaLigne).Select
    ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Cut
    
    Maligne2 = Range("A23").End(xlDown).Address
    Maligne2 = Range(Maligne2).Row
    
    Maligne3 = Maligne2 + 1 '(à partir de là, ça coince) ... ça ne coince plus ;o) et si ça coince il faut caler le 2ème tableau (Nom de l'entreprise) sur la ligne 23 

' /!\ Attention si on insère une ligne on décale tout vers le bas et la macro ne s'exécute plus ....
    
    Range("A" & Maligne3).Select
    ActiveSheet.Paste
    
    Range("A" & MaLigne & ":D" & MaLigne).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    End If
    
End If

End Sub


Dis moi si ça colle ?

;o)

Binouses · Answer

Pétard oui!!!

MERCIIIIIIIIIIIIII

J'ai vu ton avertissement pour l'insertion de ligne, vois-tu une solution?

La plus simple, selon moi, serait que je décale le tableau du bas à côté du premier. Mais il faut que je modifie le couper/coller pour le cantonner aux cellules du tableau et non à la ligne entière.

Par contre, saurais-tu m'expliquer ce que tu as fait ? (si tu as le temps biensûr)

Car, avoir une macro qui fonctionne c'est génial.. mais COMPRENDRE comment elle fonctionne, c'est encore mieux.

En tout cas, merci beaucoup à toi!!!

Polux31 · Answer

Voilà ce que j'ai fait :

- J'ai changé l'évènement SelectionChange(Target As Range) par l'évènement Change(Target As Range)

- Ensuite j'ai mis 2 contrôles :
If Target.Column <> 3 Then Exit Sub pour n'effectuer la macro que si l'on est dans la colonne C de la feuille.

If Target.Text = "" Then Exit Sub pour ne pas effectuer la macro si la cellule de la colonne D est vide

Pour le reste c'est essentiellement ton code remis en ordre en y ajoutant le contrôle d'une réponse dans le msgbox (vbYesNo). Si la réponse est non, on sort de la macro, sinon on effectue le reste du code.

J'ai ensuite ajouté la mise en forme de la ligne qui est "cutter". On peut facilement l'obtenir en utilisant l'enregistreur de macro.

Pour ce qui est de l'insertion d'une ligne avant le 2ème tableau il faut récupérer la 1ère ligne du second tableau avant de faire la mise à jour

Je regarde ça et je te donne la réponse

Polux31 · Answer

Voila la macro modifiée:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MaLigne, somme, depassement, Autirage As Variant

'Contrôle de validité de la sélection
If Target.Column <> 3 Then Exit Sub  'Colonne D
If Target.Text = "" Then Exit Sub    'Cellule vide


somme = Range("B2").Value
Autirage = Range("B1").Value

depassement = somme - Autirage

If somme > Autirage Then
    rep = MsgBox("Attention, vous dépassez votre autorisation de tirage de " & depassement & " euros!" & vbCrLf _
            & "Voulez-vous continuer ?", vbYesNo)
    If rep = vbNo Then
        'Clique sur "Non", on sort
        Exit Sub
    Else
        'Clique sur "Oui"
        MaLigne = Range("C4").End(xlDown).Address
        MaLigne = Range(MaLigne).Row
        
        Range("A" & MaLigne).Select
        ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Cut
        
        'Récupération de la 1ère ligne du 2ème tableau
        Cells.Find(What:="TOTAL de votre souhait de contrats", After:=ActiveCell, _
            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
        numLig = ActiveCell.Row
        numLig = numLig + 3
        'recherche de la 1ère ligne vide du tableau
        Maligne2 = Range("A" & numLig).End(xlDown).Address
        Maligne2 = Range(Maligne2).Row
        
        Maligne3 = Maligne2 + 1
        
        Range("A" & Maligne3).Select
        ActiveSheet.Paste
        
        'Mise en forme des cellules coupées du 1er tableau
        Range("A" & MaLigne & ":D" & MaLigne).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End If
    
End If

End Sub


J'ai considéré que la 1ère ligne du second tableau se trouve 3 lignes plus bas que la ligne contenant : "TOTAL de votre souhait de contrats".

voilà.

;o)

Binouses · Answer

Il me met un bug à ce niveau, comme quand je l'avais faite au début :/

Range("A" & Maligne3).Select

c'est Maligne qui lui pose problème ?

Polux31 · Answer

As-tu essayé avec le code du post 11 ?

Ça fonctionne chez moi. Sauf si tu as changé quelque chose par rapport au fichier que tu m'as envoyé.

Binouses · Answer

oui oui, j'ai de suite collé le nouveau code dans vba. et ça ne fonctionne pas. la seule chose qui change, c'est le nom de la cellule :"TOTAL de votre souhait de contrats" mais que j'ai changé chez moi.

Polux31 · Answer

Et la cellule "Nom de l'entreprise" du 2ème tableau est bien 3 lignes en dessous ?

Binouses · Answer

oui. du coup je pige plus rien.

Polux31 · Answer

J'ai déposé le fichier ici https://www.cjoint.com/?bywRJ1WERB

Tu as aussi changé le nom de la cellule ici ? 

Cells.Find(What:="TOTAL de votre souhait de contrats", After:=ActiveCell, _
            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate

Binouses · Answer

oui oui, tout de suite, dès que j'ai copié la macro et que je l'ai lue.

je regarde sur le fichier que tu as fait.

merci

C'est vrai dis donc que ça marche chez toi quand on insère une ligne .. :/

je vais repartir de ton fichier du coup. C'est juste des noms à changer. on verra bien si ça fait capoter le truc aussi.

après test, non, chez toi ça continue à fonctionner . Bon ben au moins, je peux utiliser ton fichier :)

Merci beaucoup, j'espère que je ne t'ai aps trop ennuyé avec mes soucis.

Je suis ton débiteur.

Je passe le sujet en résolu.

Soucis pour execution automatique d'une macro

18 réponses

Discussions similaires