Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

problème avec le bouton supprimer et ajouter dans le code vba [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Femme Profil pro
    alger
    Inscrit en
    novembre 2015
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : Algérie

    Informations professionnelles :
    Activité : alger
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2015
    Messages : 17
    Points : 13
    Points
    13
    Par défaut problème avec le bouton supprimer et ajouter dans le code vba
    bonjour tout le monde j'ai un grand souci sa va faire une semaine que je galère et j' ai besoin de votre aide svp avec le code vba des boutons supprimer et ajouter dans userform voila mon problème dans ma feuil excel 'BDA' le début d’enregistrement des lignes commence de (A3:F).
    Quant la ligne (A3:F) et vide et je lance Userform puis je clic sur B_nouveau il me renvois cette erreur ' erreur d'execution '13' Incompatible de type' elle s'arrêt sur la ligne suivante
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Me.TextBox14 = f.Cells(LigneEnreg - 1, 1) + 1
    dans

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
    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 je remplir la première ligne (A3:F) et juste A3= N° ET B3= DATE Manuellement au lancement de nouveau le userform le bouton nouveau fonction et sans erreurs

    pour le bouton supprimer quand y a plusieurs lignes remplis dans la feuil 'BDA'(A3:F) il s'execute normale il sufit juste de sélectionner une ligne dans la lisbox dans userform et de clic sur supprimer mais quand j'arrive a la premier ligne (A3:F3) et la dernier a supperimer 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    If UCase(bv(i, 3)) Like clé1 Then If bv(i, 2) <> "" Then d2(bv(i, 2)) = CDate(bv(i, 2))  ' Date
    dans
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    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 le remplissages des label dans mon userform voila le reste de mon code et mon fichier en pièce jointe merci a vous tous du fond de mon cœur bonne et excellente nuit
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    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
    Fichiers attachés Fichiers attachés

  2. #2
    Membre émérite Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    mars 2007
    Messages
    1 299
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 65
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : mars 2007
    Messages : 1 299
    Points : 2 800
    Points
    2 800
    Par défaut
    Bonjour,

    Cette erreur survient lorsqu'on fait un amalgame entre différents types de variables !
    Voir : https://silkyroad.developpez.com/VBA/LesVariables/ et en particulier le § III
    Cordialement,
    Patrice
    Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.

    Pour dire merci, cliquer sur et quand la discussion est finie, penser à cliquer sur

  3. #3
    Membre expert Avatar de BENNASR
    Homme Profil pro
    Responsable comptable & financier
    Inscrit en
    décembre 2013
    Messages
    1 833
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Responsable comptable & financier
    Secteur : Finance

    Informations forums :
    Inscription : décembre 2013
    Messages : 1 833
    Points : 3 050
    Points
    3 050
    Par défaut
    sbah el khir ANISSA / bonjour la forum
    Tu demande à ton code de quitter si B3 est vide alors si cette condition est satisfait le code ne continuer pas l'exécution
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If f.[B3] = "" Then Exit Sub
    Autre problème et lors de l'enregistrement d'une nouvelle ligne , tu peux pas charger textbox14 si f.Cells(LigneEnreg - 1, 1) est vide
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Me.TextBox14 = f.Cells(LigneEnreg - 1, 1) + 1
    j'ai porté quelques modifications et j'espère que ça t'aides à avancer
    NB : je suis autodidactes donc méfiez de mes propositions
    Fichiers attachés Fichiers attachés
    -----------------------------------------------*****-------------------------------------------------------------------------------------------
    you don't have to be muslim to support the Palestinian people you just have to be human
    Vous ne devez pas être musulman pour soutenir le peuple palestinien, vous devez juste être humain

  4. #4
    Membre à l'essai
    Femme Profil pro
    alger
    Inscrit en
    novembre 2015
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : Algérie

    Informations professionnelles :
    Activité : alger
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2015
    Messages : 17
    Points : 13
    Points
    13
    Par défaut non résolu
    bonjour BENNASR et merci pour ton aide

    le problème n'est pas vraiment résolu, pour le bouton supprimer y a que le renvois d'erreur qui y a était corrige
    quand je supprime la dernier ligne (A3:E3) et le tableau de la feuil 'BDA' et vide (A3:F) ma listbox affiche la ligne '(A2:E3) = en tete du tableau' , et je perds tout le remplissage de mes label sur userform a son redémarrage.

    je voudrai qu'il affiche rien dans la listbox après supprimer tout les lignes (A3:E) de feuil 'BDA'

    pour le bouton nouveau impossible de généré un numéro dans la TextBox14 ou de valide les donnée de userform sur la feuil 'BDA' tous ça après avoir supprime tout lignes (A3:E) de feuil 'BDA'
    j'espere vous lires tous bien tôt et merci encor une fois pour votre aide bonne soirée

  5. #5
    Membre expert Avatar de BENNASR
    Homme Profil pro
    Responsable comptable & financier
    Inscrit en
    décembre 2013
    Messages
    1 833
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Responsable comptable & financier
    Secteur : Finance

    Informations forums :
    Inscription : décembre 2013
    Messages : 1 833
    Points : 3 050
    Points
    3 050
    Par défaut
    bonsoir anissa et toujours KHAWA / bonsoir le forum
    une autre tentative à tester
    Fichiers attachés Fichiers attachés
    -----------------------------------------------*****-------------------------------------------------------------------------------------------
    you don't have to be muslim to support the Palestinian people you just have to be human
    Vous ne devez pas être musulman pour soutenir le peuple palestinien, vous devez juste être humain

  6. #6
    Membre à l'essai
    Femme Profil pro
    alger
    Inscrit en
    novembre 2015
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : Algérie

    Informations professionnelles :
    Activité : alger
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : novembre 2015
    Messages : 17
    Points : 13
    Points
    13
    Par défaut
    bonsoir BENNASR un très très très grand Merci sa marche très bien
    KAWA KAWA et YATNAHAW GA3
    vive l’Algérie et bonne soirée

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 8
    Dernier message: 10/04/2014, 01h03
  2. Réponses: 1
    Dernier message: 04/01/2012, 18h12
  3. ouvrir une requete d'ajout dans un code vba
    Par myriame dans le forum VBA Access
    Réponses: 5
    Dernier message: 28/04/2011, 10h25
  4. Problème avec un bouton dans un formulaire
    Par mademoizel dans le forum Langage
    Réponses: 1
    Dernier message: 06/01/2008, 13h51
  5. Problème avec les boutons de perl Tk
    Par jkevin2 dans le forum Interfaces Graphiques
    Réponses: 4
    Dernier message: 02/09/2005, 18h18

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo