Problème de code VBA demande aide pour correction

[abtony]

Bonsoir le forum, Bonsoir tous,

Je rencontre un problème sur mon code ci-dessous, La ligne verte quand activer me bloque vba et me met pas a jour les information du textbox1 (TBX1).
les autre lignes en dessous pas de problème cela se met a jour correctement.

Merci d'avance pour votre aide

Bonne soirée

quelle est la solution ? et d'ou vient le soucis !

 Private Sub CommandButton4_Click()
Dim I As Long
Dim Lib As Range
Dim Lg As Long, LB4Lg As Integer, LBxLg As Integer
Dim n As Byte
Dim WS As Worksheet, WSFound As Worksheet

Dim R As Variant
R = InputBox("Veuillez saisir le mot de passe : ", "Accès protégé..")
If R = MDP Then
    'MaMacro
Else
MsgBox "Mot de passe incorrect", vbCritical, "Invalide"
    Exit Sub
End If

Application.ScreenUpdating = False
'Sheets(baseprix.Caption).Activate
Range("B5").Select
     If TBX1 = "" Then
         MsgBox "La Désignations ne peut pas être vide, veuillez compléter", vbCritical, "Invalide"
    Exit Sub
End If
     Do Until ActiveCell.Value = TBX1.Value
            If ActiveCell.Value = TBX1.Value Then
            MsgBox "Ce composant existe Déjà." & Chr(13) & _
            "Remplacer la valeur ?", vbYesNo + vbInformation, "Information !"
      If ActiveCell.Value = baseprix.TBX1 Then Exit Do
End If
    ActiveCell.Offset(1, 0).Select

      Loop
          'ActiveCell.Value = TBX1.Value
         ActiveCell.Offset(0, 1).Value = TBX2.Value
         ActiveCell.Offset(0, 2).Value = CDbl(TBX3.Value)
         ActiveCell.Offset(0, 3).Value = CDbl(TBX4.Value)
         ActiveCell.Offset(0, 4).Value = CDbl(TBX5.Value)
         ActiveCell.Offset(0, 4).Font.ColorIndex = 3
         ActiveCell.Offset(0, 4).Font.Bold = True
         ActiveCell.Offset(0, 7).Value = "Modifié le " & Format(Date, "dd/mm/yyyy") & " à " & Format(Now, "hh:mm:ss") 'Format(Date, "dd/mm/yy")
         On Error Resume Next
         ActiveCell.Offset(0, 5).Value = CDbl(TBX6.Value)
         ActiveCell.Offset(0, 6).Value = CDbl(TBX7.Value)
         
         

MsgBox "Ce composant a été modifier ", vbOKOnly + vbInformation
Application.ScreenUpdating = True

 

[Chris401]

Re : Problème de code VBA demande aide pour correction

Bonsoir

Essaye avec

Sheets(baseprix.Text).Activate

Cordialement
Chris

 

[abtony]

Re : Problème de code VBA demande aide pour correction

Bonsoir Chris401, merci pour la réponse,

Quand j'active Sheets(baseprix.Text).Activate ou (Activate a la place de Text) + ActiveCell.Value = TBX1.Value

Ca bloque sur Loop

 

[Chris401]

Re : Problème de code VBA demande aide pour correction

Re

Essaye :

Private Sub CommandButton1_Click()
Dim I As Long
Dim Lib As Range
Dim Lg As Long, LB4Lg As Integer, LBxLg As Integer
Dim n As Byte
Dim WS As Worksheet, WSFound As Worksheet

Dim R As Variant
R = InputBox("Veuillez saisir le mot de passe : ", "Accès protégé..")
If R = MDP Then
    'MaMacro
Else
MsgBox "Mot de passe incorrect", vbCritical, "Invalide"
    Exit Sub
End If

Application.ScreenUpdating = False
Sheets(baseprix.Text).Activate
Range("B5").Select
     If TBX1 = "" Then
         MsgBox "La Désignations ne peut pas être vide, veuillez compléter", vbCritical, "Invalide"
    Exit Sub
End If

     Do Until ActiveCell.Value = TBX1.Value
            If ActiveCell.Value = TBX1.Value Then
            MsgBox "Ce composant existe Déjà." & Chr(13) & _
            "Remplacer la valeur ?", vbYesNo + vbInformation, "Information !"
            If ActiveCell.Value = TBX1.Value Then Exit Do
            End If
    ActiveCell.Offset(1, 0).Select

      Loop
          ActiveCell.Value = TBX1.Value
        ActiveCell.Offset(0, 1).Value = TBX2.Value
         ActiveCell.Offset(0, 2).Value = CDbl(TBX3.Value)
         ActiveCell.Offset(0, 3).Value = CDbl(TBX4.Value)
         ActiveCell.Offset(0, 4).Value = CDbl(TBX5.Value)
         ActiveCell.Offset(0, 4).Font.ColorIndex = 3
         ActiveCell.Offset(0, 4).Font.Bold = True
         ActiveCell.Offset(0, 7).Value = "Modifié le " & Format(Date, "dd/mm/yyyy") & " à " & Format(Now, "hh:mm:ss") 'Format(Date, "dd/mm/yy")
        On Error Resume Next
         ActiveCell.Offset(0, 5).Value = CDbl(TBX6.Value)
         ActiveCell.Offset(0, 6).Value = CDbl(TBX7.Value)

MsgBox "Ce composant a été modifié ", vbOKOnly + vbInformation
Application.ScreenUpdating = True
End Sub

Reste un soucis que je n'arrive pas à régler : Si on répond NON au changement, il se fait quand même.
J'ai essayé avec

IF (MsgBox "Ce composant existe Déjà." & Chr(13) & _
            "Remplacer la valeur ?", vbYesNo + vbInformation, "Information !") = vbYes then

mais message d'erreur sur la boucle ; et là, ça dépasse mes compétences.

Chris

 

[abtony]

Re : Problème de code VBA demande aide pour correction

Re,

Merci pour ton aide, j'ai essayer mais ça donne rien le problème persiste sur Loop !

Bonne soirée

 

[Paf]

Re : Problème de code VBA demande aide pour correction

Bonjour abtony, Chris401,

Je rencontre un problème sur mon code ci-dessous, La ligne verte quand activer me bloque vba et me met pas a jour les information du textbox1 (TBX1).

Il n'y a que 3 lignes vertes ! Si vous précisiez laquelle ...

Si ça bloque VBA il y a peut-être un message d'erreur ?

Quant à la mise à jour de la textbox1, je ne vois aucun code censé la mettre à jour ?

Si vous précisiez réellement votre besoin, ce qu'est censé faire le code et joigniez un classeur pour tester, on pourrait plus facilement vous aider.

A+

 

[abtony]

Re : Problème de code VBA demande aide pour correction

Bonsoir le forum, Paf,

pour être plus clair voici un bout de mon fichier, sur la feuille Gros Oeuvre Maçonnerie, ces enregistrement sont séparé par une ligne vide.

Les différent listbox filtrent les corps d'état et les ouvrages et les sous ouvrages dans ces corps d'état.

le but recherché avec le command bouton, est de modifier ou ajouter des ouvrages de la TBX1 a la TBX7.

Le code qui figure actuellement dans ce bouton ne fonctionne pas pour le TBX1.

Comment faire pour corriger ce problème ou avoir un code plus simple et fonctionnel malgré les lignes vides entre chaque ouvrages ?

Merci beaucoup de votre aide pour trouver la solution a ce soucis que je n'arrive pas seul a résoudre.

 

[Paf]

Re : Problème de code VBA demande aide pour correction

Re,

quelques modifications pour:
-si le contenu de TBX1 est trouvé mise à jour ou non suivant réponse
-si le contenu de TBX1 n'est pas trouvé création ou non suivant réponse

Dans Private Sub CommandButton1_Click()

    ... code existant
    If TBX1 = "" Then
         MsgBox "La Désignations ne peut pas être vide, veuillez compléter", vbCritical, "Invalide"
        Exit Sub
    End If
    
    '********* début modif
    With Worksheets("GROS OEUVRE MACONNERIE")
    TrouveLig = False
    For I = LigIni To Lg - 1
        If .Cells(I, 2) = TBX1.Value Then
            TrouveLig = True
            Exit For
        End If
    Next
    If TrouveLig Then
        Rep = MsgBox("Ce composant existe Déjà." & Chr(13) & _
            "Modifier les valeur ?", vbYesNo + vbInformation, "Information !")
        If Rep = vbNo Then Exit Sub
    Else
        Rep = MsgBox("Ce composant n'existe pas." & Chr(13) & _
        "Le rajouter ?", vbYesNo + vbInformation, "Information !")
        If Rep = vbNo Then
            Exit Sub
        Else
            .Rows(I).Insert Shift:=xlUp
        End If
    End If
        
    .Cells(I, 2) = TBX1.Value
    .Cells(I, 2).Offset(0, 1).Value = TBX2.Value
    .Cells(I, 2).Offset(0, 2).Value = CDbl(TBX3.Value)
    .Cells(I, 2).Offset(0, 3).Value = CDbl(TBX4.Value)
    .Cells(I, 2).Offset(0, 4).Value = CDbl(TBX5.Value)
    .Cells(I, 2).Offset(0, 4).Font.ColorIndex = 3
    .Cells(I, 2).Offset(0, 4).Font.Bold = True
    .Cells(I, 2).Offset(0, 7).Value = "Modifié le " & Format(Date, "dd/mm/yyyy") & " à " & Format(Now, "hh:mm:ss") 'Format(Date, "dd/mm/yy")
    On Error Resume Next
    .Cells(I, 2).Offset(0, 5).Value = CDbl(TBX6.Value)
    .Cells(I, 2).Offset(0, 6).Value = CDbl(TBX7.Value)
         
     End With
    If TrouveLig Then
        MsgBox "Ce composant a été modifié "
    Else
        MsgBox "Ce composant a été ajouté "
    End If

    '*************** fin modif
        
   
Application.ScreenUpdating = True

For Each WS In ThisWorkbook.Worksheets
...... suite du code

rajouter Dim TrouveLig As Boolean en début de Sub


Dans Private Sub ListBox3_Change(), Private Sub ListBox3_Change() et Private Sub ListBox3_Change()

supprimer Dim Lg As Long

puis rajouter Dim Lg As Long en tête du module pour une portée globale


Dans Private Sub ListBox3_Change()

modifier

 If Lib Is Nothing Then Exit Sub Else Lg = Lib.Row + 1

par

  If Lib Is Nothing Then
    Exit Sub
  Else
    Lg = Lib.Row + 1
    LigIni = Lg
  End If

Le principe: dans Private Sub ListBox3_Change() LigIni donne le N° de la première ligne concernée et Lg donnera la dernière ce qui limitera la recherche à cette plage de ligne dans Private Sub CommandButton1_Click()

J'espère n'avoir rien oublié

A+

Edit : rajouter Dim LigIni As Long en tête du module pour une portée globale

 

[abtony]

Re : Problème de code VBA demande aide pour correction

Bonjour le forum, bonjour Paf,

merci pour le temps que a consacré a ma problématique.

je n'ai pas essayer encore ton code, mais je constate une chose a cette ligne """With Worksheets("GROS OEUVRE MACONNERIE")""

Je n'ai pas que cette feuille Gros Ouvre Maçonnerie dans mon classeur mais, mais toutes les feuille indique sur USF Listbox1

Donc je pense qu'il y aura un soucis non ?

Simple question et je vais tester

Merci

 

[abtony]

Re : Problème de code VBA demande aide pour correction

Re,

Bon je viens d'essayer et ça bug, quand je veut modifier un enregistrement, il me dit cet enregistrement n'existe pas voulez vous l'ajouter ? et ça plante (déboguage).

 

[Paf]

Re : Problème de code VBA demande aide pour correction

Re,

Je me suis fié au contenu de Private Sub ListBox3_Change() où il est spécifié :

With Feuil9
 ... reste du code

où Feuil9 correspond à la feuille GROS OEUVRE MACONNERIE

pour prendre en compte le fait que chaque item correspond à une feuille, dans Private Sub ListBox3_Change()

remplacer

With Feuil9

par

With Worksheets(CStr(ListBox1))

Attention la feuille doit exister et son nom doit être rigoureusement identique au libellé de la listbox1 ( donc issu de la feuille TRAVAUX).

Ce n'est pas vrai pour la feuille GROS OEUVRE MACONNERIE qui comporte un espace final en feuille TRAVAUX

A+

 

[abtony]

Re : Problème de code VBA demande aide pour correction

Re,

J'ai trouvé mon erreur sur le code original.

et la tout fonctionne parfaitement.

Voir ci-dessous la modification.

Merci infiniment pour ton aide, ton code ma quand même permis de voir mes erreur.

Cordialement

Antonio

Bonne soirée

  Private Sub CommandButton4_Click()
Dim I As Long
Dim Lib As Range
Dim Lg As Long, LB4Lg As Integer, LBxLg As Integer
Dim n As Byte
Dim WS As Worksheet, WSFound As Worksheet

Dim R As Variant
R = InputBox("Veuillez saisir le mot de passe : ", "Accès protégé..")
If R = MDP Then
    'MaMacro
Else
MsgBox "Mot de passe incorrect", vbCritical, "Invalide"
    Exit Sub
End If

Application.ScreenUpdating = False
'Sheets(baseprix.Caption).Activate
Range("B5").Select
    if listbox4= "" then  'au lieu de ' If TBX1 = "" Then
         MsgBox "La Désignations ne peut pas être vide, veuillez compléter", vbCritical, "Invalide"
    Exit Sub
End If
     Do Until ActiveCell.Value = ListBox4.value au lieu de 'TBX1.Value
            If ActiveCell.Value = ListBox4.value then 'au lieu de'TBX1.Value Then
            MsgBox "Ce composant existe Déjà." & Chr(13) & _
            "Remplacer la valeur ?", vbYesNo + vbInformation, "Information !"
      If ActiveCell.Value = ListBox4 then exit Do 'au lieu de 'TBX1 Then Exit Do
End If
    ActiveCell.Offset(1, 0).Select

      Loop
          'ActiveCell.Value = TBX1.Value
        ActiveCell.Offset(0, 1).Value = TBX2.Value
         ActiveCell.Offset(0, 2).Value = CDbl(TBX3.Value)
         ActiveCell.Offset(0, 3).Value = CDbl(TBX4.Value)
         ActiveCell.Offset(0, 4).Value = CDbl(TBX5.Value)
         ActiveCell.Offset(0, 4).Font.ColorIndex = 3
         ActiveCell.Offset(0, 4).Font.Bold = True
         ActiveCell.Offset(0, 7).Value = "Modifié le " & Format(Date, "dd/mm/yyyy") & " à " & Format(Now, "hh:mm:ss") 'Format(Date, "dd/mm/yy")
        On Error Resume Next
         ActiveCell.Offset(0, 5).Value = CDbl(TBX6.Value)
         ActiveCell.Offset(0, 6).Value = CDbl(TBX7.Value)
         
         

MsgBox "Ce composant a été modifier ", vbOKOnly + vbInformation
Application.ScreenUpdating = True