Autres problème code vba avec le bouton supprimer et ajouter

samia89 · 3 Décembre 2019

bonjour tout le monde j'ai un grand souci sa va faire une semaine que je galère et j’ai du mal a résoudre le problème tout seul j’ai vraiment besoin de votre aide SVP sur le code vba des boutons supprimer et ajouter dans userform voila mon problème :
ma feuil 'BDA' du classeur l’enregistrement des lignes commence de (A3:E3).
Quant les lignes (A3:E) elles sont vide et je lance Userform puis je clic sur le bouton B_nouveau il me renvois cette erreur ' erreur d'execution '13' Incompatible de type' elle s'arrêt sur la ligne suivante:

VB:

Me.TextBox14 = f.Cells(LigneEnreg - 1, 1) + 1

Dans la partie

Code:

Private Sub B_nouveau_Click()
razChampForm
TextBox15 = Date
LigneEnreg = f.[A65000].End(xlUp).Row + 1
  Me.TextBox14 = f.Cells(LigneEnreg - 1, 1) + 1
  Me.LigneEnregC = LigneEnreg
  Me.TextBox14.SetFocus
End Sub

Mais si la première ligne (A3:E3) est remplir et juste que A3= N° ET B3= DATE Manuellement au lancement de userform le bouton nouveau fonction et sans erreurs mais si (A3:E) est vide le bouton nouveau ne génère aucun numéro dans la TextBox14=A3 et le bouton valider ne fonction plus

Pour le bouton supprimer quand y a plusieurs lignes remplis dans la feuil 'BDA'(A3:E) il s'execute normale il suffit juste de sélectionner une ligne dans la lisbox sur userform et de clic sur supprimer mais quand j'arrive a la premier ligne (A3:E3) et la dernier a supprimer de la feuil 'BDA' il me renvois cette erreur ' erreur d'execution '13' Incompatible de type' elle s'arrêt sur la ligne suivante :

Code:

If UCase(bv(i, 3)) Like clé1 Then If bv(i, 2) <> "" Then d2(bv(i, 2)) = CDate(bv(i, 2))  ' Date

Dans la partie

Code:

Private Sub ComboBox1_Change()
   Set d1 = CreateObject("scripting.dictionary")
     Set d2 = CreateObject("scripting.dictionary")
     razChampForm
     clé1 = UCase(Me.ComboBox1) & "*": clé2 = Me.ComboBox2 & "*"
 
     Dim b()
     n = 0: ncol = UBound(bv, 2)
     For i = LBound(bv) To UBound(bv)
                   'nom                         'date
       If UCase(bv(i, 3)) Like clé1 And UCase(bv(i, 2)) Like clé2 Then
 
         If bv(i, 3) <> "" Then d1(bv(i, 3)) = bv(i, 3)
         n = n + 1
         ReDim Preserve b(1 To ncol, 1 To n)
         For K = 1 To ncol: b(K, n) = bv(i, K): Next
       End If
 
       'If UCase(bv(i, 3)) Like clé2 And UCase(bv(i, 2)) Like clé1 Then If bv(i, 2) <> "" Then d1(bv(i, 2)) = bv(i, 2)
       If UCase(bv(i, 3)) Like clé1 Then If bv(i, 2) <> "" Then d2(bv(i, 2)) = CDate(bv(i, 2))  ' Date
      Next i
 
      If n > 0 Then
        ReDim Preserve b(1 To ncol, 1 To n + 1)
        Me.ListBox1.List = Application.Transpose(b)
        Me.ListBox1.RemoveItem n
        Cbx1 = d1.Keys
        Call tri(Cbx1, LBound(Cbx1), UBound(Cbx1))
        Me.ComboBox1.List = Cbx1
        If ActiveControl.Name = "ComboBox1" Then Me.ComboBox1.DropDown
        Cbx2 = d2.items
        Call tri(Cbx2, LBound(Cbx2), UBound(Cbx2))
        Me.ComboBox2.List = Cbx2
      End If
 
End Sub

a ce stade quand je relance le user forme je perds tout les remplissages des label dans mon userform
et la listebox affiche l’entête de la feuil 'BDA'(A2:E3) et rien ne fonction voila le reste de mon code et mon fichier en pièce jointe pour bien voir le problème merci a vous tous du fond de mon cœur bonne et excellente soirée

Code:

Private Sub B_valider_Click()
If Me.LigneEnregC <> 0 And Me.TextBox14 <> "" And LigneEnreg <> 0 Then
   lig = LigneEnreg
   For Each K In Array(1, 2, 5)
     tmp = Me("textbox" & K + 13)
     If IsNumeric(tmp) Then
        f.Cells(lig, K) = CDbl(tmp)
     Else
        If IsDate(f.Cells(lig, K)) Then
           f.Cells(lig, K) = CDate(tmp)
        Else
           f.Cells(lig, K) = tmp
        End If
     End If
   Next
   f.Cells(lig, 2) = CDate(TextBox15.Value)
   f.Cells(lig, 3) = Me.ComboBox3 'employe
   If OptionButton1 = True Then
   f.Cells(lig, 4) = "Puce1"  'unit
   End If
 If OptionButton2 = True Then
   f.Cells(lig, 4) = "Puce2"  'unit
 End If
 
 
   'f.Cells(lig, 6) = Me.ComboVille 'produit
   'f.Cells(lig, 14) = Me.TextBox27 'unit
 
   'f.Cells(lig, 5) = Me.Combocf 'client f
   'f.Cells(lig, 2) = Me.Comboaction 'action
 
   Ligne = ListBox1.ListIndex
   bv = f.Range("A3:f" & [A65000].End(xlUp).Row).Value
   ComboBox1_Change
   Me.ListBox1.ListIndex = Ligne
 razChampForm
 End If
End Sub
 
 
 
 
 
Private Sub ListBox1_Click()
  Ligne = ListBox1.ListIndex
  For Each i In Array(1, 2, 4, 5)
      Me("textbox" & i + 13) = ListBox1.List(Ligne, i - 1)
  Next i
  Me.ggg = ListBox1.List(Ligne, 2) 'categorie
 
  reservation = Me.TextBox14
  Set result = f.[A:A].Find(what:=reservation)
  If Not result Is Nothing Then
    LigneEnreg = result.Row
    Me.LigneEnregC = LigneEnreg
  Else
    MsgBox "Erreur no réservation"
  End If
End Sub
Private Sub ComboBox2_Change()
  ComboBox1_Change
End Sub
 
Private Sub UserForm_Initialize()
 
   TextBox15 = Date
  Sheets("BDA").Activate
  Feuil1.Visible = xlSheetVisible
 
  Set f = Sheets("BDA")
  If f.[B3] = "" Then Exit Sub
  bv = f.Range("a3:f" & [A65000].End(xlUp).Row).Value
 Me.ComboBox3.List = Array("Tom", "Mani", "Ramv")
 
 
  For i = 1 To UBound(bv, 2) - 1
   temp = temp & f.Columns(i).Width * 0.62 & ";"
   Me("label" & i) = f.Cells(2, i)
   Me("label" & i + 19) = f.Cells(2, i)
   Me("label" & i).Top = Me.ListBox1.Top - 15
   Largeur = Largeur + f.Columns(i).Width * 1
  Next
  Me.ListBox1.ColumnWidths = temp: Me.Width = Largeur - 128
 
  Me.ListBox1.List = bv
  '--
  Set d1 = CreateObject("scripting.dictionary")
  For i = 1 To UBound(bv)
    If bv(i, 3) <> "" Then d1(bv(i, 3)) = ""
  Next i
  Cbx1 = d1.Keys
  Call tri(Cbx1, LBound(Cbx1), UBound(Cbx1))
  Me.ComboBox1.List = Cbx1
  Me.ComboBox1.SetFocus
  '--
  Set d1 = CreateObject("scripting.dictionary")
  For i = 1 To UBound(bv)
    If bv(i, 2) <> "" Then d1(bv(i, 2)) = CDate(bv(i, 2))
  Next i
  Cbx2 = d1.items
  Call tri(Cbx2, LBound(Cbx2), UBound(Cbx2))
  Me.ComboBox2.List = Cbx2
 End Sub
 
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox1.List = Cbx1
  Me.ComboBox1.DropDown
End Sub
 
 
Sub razChampForm()
 For Each K In Array(1, 2, 4, 5)
    Me("textbox" & K + 13) = ""
 Next
 
 Me.ggg = ""
End Sub
 
Sub tri(a, gauc, droi) ' Quick sort
 
End Sub
Private Sub B_suppression_Click()
If MsgBox("Etes vous sûr?", vbYesNo) = vbYes Then
  If LigneEnreg <> 0 Then
    Rows(LigneEnreg).Delete
    bv = f.Range("a3:f" & [A65000].End(xlUp).Row).Value
    ComboBox1_Change
 
  razChampForm
  End If
 End If
End Sub

sylvanu · 3 Décembre 2019

Bonjour Samia,
Lorsque la cellule est vide, le contenu n'est pas considéré comme numérique et le calcul +1 génère une erreur.
J'ai triché en vérifiant avant si c'est numérique, sinon je mets 1 pour la première ligne :

VB:

Private Sub B_nouveau_Click()
razChampForm
TextBox15 = Date
LigneEnreg = f.[A65000].End(xlUp).Row + 1
   If IsNumeric(f.Cells(LigneEnreg - 1, 1)) = False Then
        a = 1
    Else
        a = f.Cells(LigneEnreg - 1, 1) + 1
    End If
  Me.TextBox14 = a
  Me.LigneEnregC = LigneEnreg
  Me.TextBox14.SetFocus
End Sub

Ca semble marcher, tout du moins pour ce point.

sylvanu · 3 Décembre 2019

Re,
Pour la suppression c'est la même chose. bv(i, 2)="DATE" donc quand vous faite CDate("DATE") il y a erreur.
J'ai contourné à la sauvage :

VB:

       If bv(i, 2) <> "DATE" Then
            If UCase(bv(i, 3)) Like clé1 Then If bv(i, 2) <> "" Then d2(bv(i, 2)) = CDate(bv(i, 2))  ' Date
       End If

Il n'y a plus d'erreur mais il supprime aussi la ligne de titres. Ce point reste à résoudre, surement par traitement du Else que je n'ai pas traité.

Autres problème code vba avec le bouton supprimer et ajouter

samia89

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Discussions similaires