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

[samia89]

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:

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

Dans la partie

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 :

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

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

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]

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 :

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]

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 :

       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é.