Ajouter et supprimer des lignes a partir d'une toupie

cj welch

XLDnaute Occasionnel
Re : Ajouter et supprimer des lignes a partir d'une toupie

salut ledzepfred,

je te remercie de ton interet.

Figure toi que j'ai eu des soucis avec mon ordi et le sav n'as pas été à la auteur.

Essai de mettre dans les colonnes U et W, un chiffre supérieur à 1 et tu comprendras

A+
 

ledzepfred

XLDnaute Impliqué
Re : Ajouter et supprimer des lignes a partir d'une toupie

RE...

desormais la macro permet de multiplier le nombre saisi (avec obligation de saisir un nombre) et la somme du useform, voir ci-dessous la macro modifiée (lignes en rouges)

A+
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Cells(Target.Row, 2) = "TOTAL" Then Exit Sub
If Target.Row > 8 Then
    If Target.Column = 21 Or Target.Column = 23 Then
        Target.Select
        If Target.Value <> "" Then
            [COLOR="Red"]If Not IsNumeric(Target.Value) Then MsgBox ("Veuiller saisir un nombre"): Target = "": Exit Sub[/COLOR]
            ActiveSheet.Unprotect Password:="LN"
            With Userwe
                .TextBox1.Value = Target.Row
                .TextBox2.Value = Target.Value
                .OptionButton1 = True 'valider
                .Show
            End With
        Else: Target.Offset(0, 1).Value = ""
        End If
        [COLOR="red"]Cells(Target.Row, "V") = Cells(Target.Row, "U") * Cells(Target.Row, "V")
        Cells(Target.Row, "X") = Cells(Target.Row, "W") * Cells(Target.Row, "X")[/COLOR]        Cells(Target.Row, "Y") = Cells(Target.Row, "V") + Cells(Target.Row, "X")
        ActiveSheet.Protect Password:="LN"
    End If
End If
End Sub
 

cj welch

XLDnaute Occasionnel
Re : Ajouter et supprimer des lignes a partir d'une toupie

salut ledzepfred,

la macro ne résoud pas mon problème. En effet, a chaque fois qu'on ajoute des nombres ou qu'on modifie la valeur des colonnes U et ou W, le résultat est faux.

Ne serait il pas plus simple de rajouter 2 colonnes supplémentaires et d'y inscrire le produit des colonnes U et V par exemple ?
Bien entendu, il faut ensuite pouvoir copier les formules lorsqu'on insert des lignes.

Dans l'attente de te lire

Cordialement

Cj
 

ledzepfred

XLDnaute Impliqué
Re : Ajouter et supprimer des lignes a partir d'une toupie

Salut cj welch,

avant d'envisager une modification structurelle nécessitant de revoir toutes les macros de ton fichier (ça réponds à ta question : "c'est pas plus simple d'ajouter 2 colonnes"), j'aimerais que tu modifies la Private Sub CommandButton1_Click du userform userwe comme ceci : (remplacer la ligne en vert par celle en rouge

Code:
Private Sub CommandButton1_Click()
' début du code
     [COLOR="DarkGreen"]'.Cells(L, "Y").Value = .Cells(L, "V").Value + .Cells(L, "X").Value[/COLOR]
     [COLOR="Red"].Cells(L, "Y").Value = "=SUM(RC22,RC24)"[/COLOR]
'fin du code
End Sub
Modification à ajouter à celle proposée lundi

Si cette solution ne réponds toujours pas à ta demande, j'aimerai que tu me donnes plus de détails sur le contexte de saisie des colonnes U et W et le résultat souhaité en V et X. En clair les colonnes V et X doivent-elles representer le produit de destination * montant
ou montant précédent + produit de destination * montant

A+
 
Dernière édition:

cj welch

XLDnaute Occasionnel
Re : Ajouter et supprimer des lignes a partir d'une toupie

salut ledzepfred,

la solution que tu me propose marche partiellement. Quand on rentre les nombre en U OU W, cela fonctionne, si on modifie ces chiffres alors la, le résultat est faux.

En clair les colonnes V et X doivent-elles representer le produit de destination * montant ou montant précédent + produit de destination * montant
La colonne V et X enregistre le produit de la quantité et de la déstination séléctionné.
Cad U et W = Une quantité (nb de déplacement)
V = U * Le cout du déplacement séléctionné dans l'user (ex Londre 115€), idem pour X.
Y = V + X

J'espère avoir été plus précie sur ma demande

Dans l'attente de te lire

Cordialement

Cj
 

ledzepfred

XLDnaute Impliqué
Re : Ajouter et supprimer des lignes a partir d'une toupie

re...

Par le remplacement des deux lignes indiquées dans mon message précédent, je crée une formule qui somme précisement les colles V et X, et la modification proposée lundi fait bien le produit de U * Le cout du déplacement séléctionné dans l'user,idem pour X.

Tu as parfaitement répondu à ma question mais du coup je vois pas ce qui cloche.
Fais des tests avec ce que je t'ai proposé lundi et ce soir et dis-moi en quoi le résultat ne réponds pas à ta demande.

A+
 

cj welch

XLDnaute Occasionnel
Re : Ajouter et supprimer des lignes a partir d'une toupie

re,

Quand je rentre un nombre en U et OU en W, la 1er fois cela marche bien. si tu modifie un des nombre inscrit en U ou W, le résultat ne correspond plus a la formule V = U x déstination selectionné.

Essai en respectant l'ordre suivant :
1- En U rentre le chiffre 1, séléctionne londre
2- En W rentre le chiffre 2, séléctionne bastia (jusqu'ici pas de soucis)
3- Rentre en U a la place du 1, 2 et selectionne encore londre
En Y, il est inscrit 598, alors que le résultat doit etre 326.

je te joint également le fichier qui intègre les modifications ci-dessus
Cijoint.fr - Service gratuit de dépôt de fichiers

A+
 

ledzepfred

XLDnaute Impliqué
Re : Ajouter et supprimer des lignes a partir d'une toupie

RE...

une ligne de la macro du bouton valider du userwe m'avait échappé, du coup la macro Worksheet_Change peut être simplifiée et les lignes ajoutées lundi sont inutiles :

ci-joint le fichier modifié, vois si cela te convient

Au passage 2*115+2*46=322 et non 326...

A+
 

Fichiers joints

cj welch

XLDnaute Occasionnel
Re : Ajouter et supprimer des lignes a partir d'une toupie

Re,

Merci pour la leçon gratuide de mathématique :D:D

Concernant ta modif cela fonctionne a merveille, je t'en remercie profondément. Encore une fois, tu as été fantastique avec moi.

J'ai une dernière petite demande, pourrais tu me rajouter la formule qui permet d'avoir le total de la colonne X (comme pour la colonne V)

Merci encore

Très cordialement

Cj
 

ledzepfred

XLDnaute Impliqué
Re : Ajouter et supprimer des lignes a partir d'une toupie

RE...
tjs un plaisir de t'aider mon ami;)

j'ai modifié la sub ajoutligne pour avoir la formule en X mais tu aurais pu le faire toi-même en mode débogage (Point d'arrêt et F8).

A+
 

Fichiers joints

cj welch

XLDnaute Occasionnel
Re : Ajouter et supprimer des lignes a partir d'une toupie

salut ledzepfred,

les modif apportées fonctionne super bien.
En revanche, j'ai un petit soucis au niveau du fonctionnement des scrollbar, quand on ajoute plusieurs lignes et qu'on veuille ensuite revenir (avec la flèche du haut), cela ne fonctionne pas.

Pourrais tu me résoudre ce problème

Merci d'avance

Très cordialement

Cj
 

ledzepfred

XLDnaute Impliqué
Re : Ajouter et supprimer des lignes a partir d'une toupie

salut cjwelch,

j'ai beau testé de mon côté sur la dernière version transmise, je n'ai pas de pb pour l'utilisation des scrollbar (d'ailleurs je n'ai pas touché au code initial)

Peux-tu m'expliquer le pb?

A+
 

cj welch

XLDnaute Occasionnel
Re : Ajouter et supprimer des lignes a partir d'une toupie

re,

j'ai testé le n°1
J'ai ajouter 6 lignes a la suite en utilisant la flèche du bas
Ensuite, j'ai fais l'opération inverse et là rien ne se passe

J'espère avoir été prècis

bisard, je viens de refaire l'expérience et la ça fonctionne.

Je cherche pourquoi ça bloque a certain moment et je reviens vers toi.

A+


A+
 
Dernière édition:

ledzepfred

XLDnaute Impliqué
Re : Ajouter et supprimer des lignes a partir d'une toupie

RE,

effectivement, des clics dans tous les sens perturbe le comportement des scrollbar, mais je ne pense pas que cela vienne du code ou en tout cas, je sèche!
Tu as remarqué cela depuis quand?

Edit: pour en avoir le coeur net j'ai placé un point d'arret sur la ligne Set scrol=scrollbar de chaque private Sub scrollbar_change et quand je clique sur les scrollbar, la macro ne démarre pas,
c'est donc lié au controle scrollbar et deplus c'est aléatoire, c'est incompréhensible!!

A+
 
Dernière édition:

cj welch

XLDnaute Occasionnel
Re : Ajouter et supprimer des lignes a partir d'une toupie

salut ledzepfred,

Ce qui est incroyable, c'est que c'est a partir du fichier Véhicule vf3 que j'ai construit la version 4, en modifiant principalement 3 formules de calculs qui bloquais.

Je cherche depuis, un petit moment, le pourquoi du comment et je n'ai pas d'explication. Des fois ça marche d'autre fois ça bloque. Pourquoi ? Mystère.

Je me demande s'il ne serait pas plus intéressant de supprimer ce bouton et de creer un bouton qui ajoute des lignes et un bouton qui remait a zero. Quand pense tu ?

Dans l'attente de te lire

Cordialement

Cj
 

ledzepfred

XLDnaute Impliqué
Re : Ajouter et supprimer des lignes a partir d'une toupie

salut cjwelch,

désolé de te répondre si tard mais bon mieux vaut tard que jamais.

après pas mal d'essais pour reproduire le bug et pas mal de recherche j'ai peut-être trouvé le problème, il faut en fait lié la valeur du scrollbar au nombre de lignes de chaque tableau :

exemple : si tu as quatre lignes dans le tableau 1, la valeur du scrollbar doit être de 4, si la valeur du scrollbar est de 1, alors il faudra 4 clics pour insérer une ligne.
En ajoutant simplement en fin de code : scrol=def.count, ça semble résoudre ce bug intermittent. Ci-dessous le code que j'ai testé et qui semble fonctionner parfaitement

Code:
Public Scrol As Object
Sub AjoutLigne()
Application.ScreenUpdating = False
'ActiveSheet.Unprotect Password:="LN"
Scrol.Placement = 2 'dimensions scrollbar figées
Set def = Range("def" & Right(Scrol.Name, 1)).Cells
Set ins = Range("ins" & Right(Scrol.Name, 1)).Cells
H = def.Count - 1
    If def.Count < Scrol Then
        Answer = MsgBox(Prompt:="Voulez-vous ajouter un mois ?", Buttons:=vbYesNo + vbQuestion)
        If Answer = vbYes Then
            ins(1).EntireRow.Insert
            ins(1).Offset(-2, 0).EntireRow.Copy
            ins(1).Offset(-1, 0).EntireRow.PasteSpecial xlPasteFormats
            
            Range(Cells(ins.Offset(-2, 0).Row, "B"), Cells(ins.Offset(-1, 0).Row, "Y")).Borders(xlInsideHorizontal).LineStyle = xlContinuous
            Range(Cells(ins.Offset(-2, 0).Row, "B"), Cells(ins.Offset(-1, 0).Row, "Y")).Borders(xlInsideHorizontal).Weight = xlThin
            For i = 2 To 17
            
            ins.Offset(0, i).FormulaR1C1 = "=SUM(R[-" & H + 1 & "]C:R[-1]C)"
            Next
            ins.Offset(0, 11).ClearContents: ins.Offset(0, 12).ClearContents
            Cells(ActiveCell.Row, 16).FormulaR1C1 = Cells(ActiveCell.Row - 1, 16).FormulaR1C1
            ins.Select
            End If
    Else
        For i = 2 To H 'pour toutes les lignes insérées en commencant par la première
            lig = Range(def(i), def(i)).Row 'lig définit numéro de cette ligne
            x = Application.WorksheetFunction.CountA(Rows(lig)) 'x=nombre de valeurs dans cette ligne
            If x = 1 Then def(i).EntireRow.Delete: Exit For 'si la ligne est renseignée (x>0), passe à la ligne suivante, sinon supprime la ligne et sort de la boucle
        Next
    End If
[COLOR="Red"]Scrol = def.Count[/COLOR]
Scrol.Placement = 1 'dimensions scrollbar fonction des cellules
Application.ScreenUpdating = True
'ActiveSheet.Protect Password:="LN"
End Sub
A+
 

Discussions similaires


Haut Bas