Microsoft 365 Userform Modification

eric72

XLDnaute Accro
Bonsoir à tous,
J'ai un code qui me permet de modifier des données en passant par un Userform, il fonctionne mais seulement 1 fois sur 2 ou 3, je pensais que ça n'était pas possible mais si je vous assure
Y a t il une boulette??
Voilà a question du soir!!!

Private Sub BtModifPlaque_Click()
'Procédure bouton Modifier
Dim X As Integer, derligne As Integer
If Cells(Rows.Count, 4).End(xlUp).Row = 1 Then
derligne = 2
Else
derligne = Cells(Rows.Count, 4).End(xlUp).Row
End If
For X = 1 To derligne
Application.ScreenUpdating = False
Sheets("Données").Visible = True
Worksheets("Données").Activate
Call Unprotect
If LstPlaque.ListIndex = -1 Then MsgBox "Vous n'avez pas sélectionné de Ligne à Modifier": Exit Sub
If Cells(X, 4) = LstPlaque.List(LstPlaque.ListIndex, 0) Then
Cells(X, 4) = TxtRefPlaque.Value
Cells(X, 5) = CDbl(TxtNbTrouPlaque.Value)
Cells(X, 6) = CDbl(TxtDiamTrouPlaque.Value)
Cells(X, 7) = CDbl(TxtPrixPlaque.Value)
End If
Next X
question = MsgBox("voulez vous Modifier un autre Produit", vbQuestion + vbYesNo, "Information")
If question = vbYes Then
Unload Me
UsfmODIFGeneral.MultiPage1.Value = 3
UsfmODIFGeneral.Show
Else
Unload Me
End If
Call Tri_Tb
Call Protect
Sheets("Données").Visible = False
Application.ScreenUpdating = True
Sheets("Menu").Activate

End Sub
Merci à tous pour votre aide
Eric
 

patricktoulon

XLDnaute Barbatruc
bon j'ai regardé de plus pres c'est normal qu'il y avait une erreur
tu a des textbox numeric oui mais c'est des code avec un espace donc cdbl plante donc on change le test
on test si cest numerique comme ca l'espace ne passe pas
j'ai testé c'est bon
VB:
Private Sub BtModifProduit_Click()
    Dim TBL
    With Range("TbProduit").ListObject
        If LstProduit.ListIndex = -1 Then MsgBox "Vous n'avez pas sélectionné de Ligne à Modifier": Exit Sub
        TBL = Array(TxtLibelle, TxtCodeArticle, TxtPrixVente, TxtCdt, TxtGencod, TxtCodeLM, TxtPvLM, TxtCodeAPEX, TxtPvAPEX, TxtCodeGAMMVERT, _
                    TxtPvGAMMVERT, TxtCodeAUCHAN, TxtPvAUCHAN, TxtGencodTRUFF, TxtCodeTRUFF, TxtPvTRUFF, TxtPvCactusClub, TxtPvParticulier, ChbECommPro)
        For I = 1 To UBound(TBL) - 1
            If IsNumeric(TBL(I)) > 0 Then TBL(I) = CDbl(TBL(I))
        Next
                
        .ListRows(LstProduit.ListIndex + 1).Range.Value = TBL

        'on modifie la ligne selectionnée
    End With
    Alimenter_List LstProduit, Range("TbProduit").Value    'on remet la listbox a jour automatiquement
    TxtLibelle = "": TxtCodeArticle = "": TxtPrixVente = "": TxtCdt = "": TxtGencod = "": TxtCodeLM = "": TxtPvLM = "": TxtCodeAPEX = "": _
            TxtPvAPEX = "": TxtCodeGAMMVERT = "": TxtPvGAMMVERT = "": TxtCodeAUCHAN = "": TxtPvAUCHAN = "": TxtGencodTRUFF = "": TxtCodeTRUFF = "": _
            TxtPvTRUFF = "": TxtPvCactusClub = "": TxtPvParticulier = "": ChbECommPro = "":
LstProduit.ListIndex = -1
End Sub
 

patricktoulon

XLDnaute Barbatruc
la page cout trans
VB:
'*************************************************************************************************
'PAGE Coût Trans -->TbCalcTransVente
'*************************************************************************************************
Private Sub TxtCoeffTransBox_Change(): calculBox: End Sub
Private Sub TxtCoutBox_Change(): calculBox: End Sub
Private Sub TxtPoidsBox_Change(): calculBox: End Sub

Sub calculBox() 'encore une sub generique
Dim critere As Boolean
critere = TxtCoutBox.Value <> "" And TxtPoidsBox.Value <> "" And TxtCoeffTransBox.Value <> ""
If critere Then TxtPrixKgTrans = Round((CDec(TxtCoutBox) / CDec(TxtPoidsBox)) * CDec(TxtCoeffTransBox), 2) Else TxtPrixKgTrans = ""
End Sub

Private Sub LstCoutTransAval_Click()
    With LstCoutTransAval
        TxtPoidsBox = .Value
        TxtCoutBox = .List(.ListIndex, 1)
        TxtCoeffTransBox = .List(.ListIndex, 2)
        'TxtPrixKgTrans = .List(.ListIndex, 3)
    End With
    End Sub

Private Sub BtModifCoutTrans_Click()
    If TxtPrixKgTrans = "" Then MsgBox "remplissez les valeurs": Exit Sub
    With Range("TbCalcTransVente").ListObject
        If LstCoutTransAval.ListIndex = -1 Then MsgBox "Vous n'avez pas sélectionné de Ligne à Modifier": Exit Sub
        .ListRows(LstCoutTransAval.ListIndex + 1).Range.Value = Array(CDbl(TxtPoidsBox), CDbl(TxtCoutBox), CDbl(TxtCoeffTransBox), CDbl(TxtPrixKgTrans))   'on modifie la ligne selectionnée
    End With
    Alimenter_List LstCoutTransAval, Range("TbCalcTransVente").Value    'on remet la listbox a jour automatiquement
    TxtPoidsBox = "": TxtCoutBox = "": TxtCoeffTransBox = "": TxtPrixKgTrans = ""
End Sub
'*************************************************************************************************
 

patricktoulon

XLDnaute Barbatruc
la page com central
VB:
'*************************************************************************************************
'PAGE Comm Centrale-->TbCommCentrale
'*************************************************************************************************
Private Sub TxtPourcentageComm_Change()
If TxtPourcentageComm <> "" Then TxtCoeffComm = TxtPourcentageComm + 1
End Sub

Private Sub LstCommCentrale_Click()
    With LstCommCentrale
        TxtPourcentageComm = .Value
        TxtCoeffComm = .List(.ListIndex, 1)
    End With
    TxtCoeffComm = TxtPourcentageComm / 10 + 1
End Sub

Private Sub BtModifComm_Click()
    With Range("TbCommCentrale").ListObject
        If LstCommCentrale.ListIndex = -1 Then MsgBox "Vous n'avez pas sélectionné de Ligne à Modifier": Exit Sub
        .ListRows(LstCommCentrale.ListIndex + 1).Range.Value = Array(CDbl(TxtPourcentageComm), CDbl(TxtCoeffComm))    'on modifie la ligne selectionnée
    End With
    Alimenter_List LstCommCentrale, Range("TbCommCentrale").Value    'on remet la listbox a jour automatiquement
    TxtPourcentageComm = "": TxtCoeffComm = ""
End Sub
'*************************************************************************************************
 

eric72

XLDnaute Accro
Ca c'est sur c'est amplement mérité (je n'ose meme pas te dire que dans ce fichier il y a un autre userform aussi pourri!!! lol)
Je ne sais pas comment te remercier pour le travail fourni, c'est géant ce que tu as fait...
Merci Merci et encore Merci
Eric
 

Discussions similaires

Réponses
17
Affichages
760

Statistiques des forums

Discussions
311 725
Messages
2 081 944
Membres
101 849
dernier inscrit
florentMIG