XL 2010 VBA problème code avec 2CDbl - erreur de compatibilité

[Emirogo]

Bonsoir,

J'ai crée un formulaire tout simple pour alimenter un petit tableau de compte avec des debits et des crédits.

J'ai un soucis lors de l'enregistrement des données. J'ai en effet mis Cdbl(me.debit) et Cdbl(me.credit) pour que mes données soient exportés en nombre et non en texte mais visiblement VBA n'aime pas ça car il me met une erreur 13 de compatibilité.

Quelqu'un aurait il de l'aide à me fournir ?

Merci par avance.

 

[Dranreb]

Bonsoir vous pourriez écrire cette fonction quelque part

Function ValTBx(TBx As MSForms.TextBox)
   Dim Z As String: Z = Replace$(TBx.Text, ".", ",")
   If Z = "" Then
      ValTBx = Empty
   ElseIf IsDate(Z) Then
      ValTBx = CDate(Z)
   ElseIf IsNumeric(Z) Then
      If Z Like "*€" Then ValTBx = CCur(Z) Else ValTBx = CDbl(Z)
   Else
      ValTBx = Trim$(TBx.Text)
      End If
   End Function

Et faire des :

Sheets("cic_courant").Range("g" & dlt) = ValTBx(Me.debit)

Remarque: de D à J comme ça c'est 7 fois plus long à exécuter que si vous affectiez les valeurs des contrôles aux éléments d'un tableau dynamique d'une ligne, puis affectiez tout le tableau en une fois à Sheets("cic_courant").Range("D:J").Rows(dlt).Value
Surtout que vous travaillez avec un tableau Excel en plus. La méthode Add de la collection ListRows renvoie un objet ListRow, lequel a une propriété Range qui représente la ligne ajoutée Vous pourriez donc faire cet ajout à la fin par
Sheets("cic_courant").ListObjects(1).ListRows.Add.Range.Value = TVL
TVL comme Tableau des Valeurs de la Ligne. Déclaré TVL(1 To 1, 1 To 7) et renseigné par des instructions TVL(1, 1) = ValTBx(Me.txtdate) etc.
Il y a même une ressource qui s'occupe de ces mouvement automatiquement, il n'y a qu'à lui indiquer dans la Sub UserForm_Initialize à quelle colonne correspond chaque contrôle à prendre en charge.

 

[patricktoulon]

re
bonjour le fil
le code du userform en entier

Private Sub categorie_Change()
    Dim colonne&
    Me.souscat = Clear
    colonne = Me.categorie.ListIndex + 3
    With Sheets("config")
        souscat.List = .Range(.Cells(4, colonne), .Cells(Rows.Count, colonne).End(xlUp)).Value
    End With
End Sub



Private Sub CommandButton1_Click() 'Enregistrement
    Dim R
    '**********************
    'peut etre ici vérifier qu'il n'y a pas un textbox vide !!! :)
    '***********************
    With Sheets("cic_courant").ListObjects(1)
        'controler si la base de donner est vide ou non - si pas vide ajout d'une ligne(la ligne rouge on la compte pas donc 2
        If .ListRows.Count = 2 And .ListRows(2).Range.Cells(1) = "" Then
            Set R = .ListRows(2).Range.Resize(, 7)
        Else
            .ListRows.Add
            'on recup le range de la new listrowsque l'on resize a 7 car la 8 eme a la formule automatiquement incrémentée(tableau structuré)on ne la touche pas donc
            Set R = .ListRows(.ListRows.Count).Range.Resize(, 7)
        End If
    End With

    Debug.Print R.Address
    'on peut faire comme ceci
    'r(1) = CDate(Me.txtdate)
    'r(2) = Me.libelle
    'r(3) = Me.paiement
    'r(4) = Val(Me.debit)
    'r(5) = Val(Me.credit)
    'r(6) = Me.categorie
    'r(7) = Me.selctsouscat

    'ou comme cela
    R.Value = Array(CDate(Me.txtdate), Me.libelle, Me.paiement, Val(Replace(Me.debit, ",", ".")), _
                    Val(Replace(Me.credit, ",", ".")), Me.categorie, Me.selctsouscat)

 Unload Me 'on ferme le userform
End Sub

Private Sub CREDIT_AfterUpdate(): Me.credit = Format(Replace(Me.credit, ".", ","), "currency"): End Sub

Private Sub debit_AfterUpdate(): Me.debit = Format(Replace(Me.debit, ".", ","), "currency"): End Sub

Private Sub souscat_Click(): Me.selctsouscat.Value = Me.souscat.Value: End Sub

Private Sub txtdate_AfterUpdate()    'on passe maintenant par le beforeupdate qui possede la propriété "cancel" au cas ou la date serait invalide
End Sub
Private Sub txtdate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    With txtdate
        If .Value <> "" Then
            If Not IsDate(.Value) Then
                Cancel = True: .SetFocus: .SelStart = 0: txtdate.SelLength = 10: Beep
                MsgBox "date non valide"
            Else
                .Value = Format(CDate(.Value), "dd/mm/yyyy")
            End If
        End If
    End With
End Sub

j'ajouterais que si tes listes(dans config) avaient été des tableaux structurés on se casserais moins la tète puisque l'on obtient le range par le nom de l'entete

 

[Dranreb]

Bonjour.
Pourquoi ne pas faire Set R = Sheets("cic_courant").ListObjects(1).ListRows.Add.Range ?
Si le tableau est vide la ligne sous les entêtes n'est pas couverte par un ListrRow, ListRows.Count = 0, et DataBodyRange n'est pas défini.
Je préfère vider la cellule quand des montants ne sont pas renseignés plutôt que de mettre 0, mais c'est vrai que comme ça, ça ne provoque plus non plus d'incompatibilité de type.

 

[Emirogo]

Bonjour à vous 2 et merci infiniment pour votre aide.

Cela fonctionne parfaitement.

J'en apprends tous les jours grâce aux utilisateurs de ce forum.

Un tés bon week end.