VBA PB avec une partie de mon code

Arpette

XLDnaute Impliqué
Bonjour à toutes et à tous,
j'ai petit problème avec une partie de mon code.Je saisis une rérérence en colonne A et ça me renvoi différentes valeurs en B,C,E ensuite s'ouvre une InputBox pour saisir la quantité qui se place en D et le calcul total ce fait en F. Ce que je souhaiterais, c'est si la personne fait une erreur de saisie dans la quantité, il puisse modifier directement en D et que le calcul se réactualise.
mMerci votre aide
@+
Code:
'Si la modification a lieu ailleurs qu'en A21:A106, sort de la procédure
If Intersect(Target, Range("A21:A106")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Target = UCase(Target) 'Met en majuscule
        If Target.Value = "" Then ' On efface la donnée
            Target.Resize(1, 6).ClearContents
            Else ' Donc une nouvelle donnée
    With Sheets("Fournisseurs") ' Prend en compte l'onglet "Fournisseurs"
        Set pl = .Range("A2:A" & .Range("A65536").End(xlUp).Row) ' Définit la plage de recherche
    End With ' Fin de la prise en compte de l'onglet "Fournisseurs"

    Set r = pl.Find(Target.Value, , xlValues, xlWhole) ' Définit la recherche
        If r Is Nothing Then ' Si pas trouvé on sort
            MsgBox "Code non trouvé !" ' Message
        Application.EnableEvents = True
        Exit Sub
        End If
  
    'Place le résultat en B,C,E
    Target.Offset(0, 1).Value = r.Offset(0, 1).Value
    Target.Offset(0, 2).Value = r.Offset(0, 2).Value
    Target.Offset(0, 4).Value = r.Offset(0, 4).Value
    Cells(Target.Row, 4) = InputBox("Saisir Quantité")
    Cells(Target.Row, 6).Value = Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value
End If
 

Banzai64

XLDnaute Accro
Re : VBA PB avec une partie de mon code

Bonjour

Avec une partie de code pas facile à trouver

Je suis parti d'un code que j'avais

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim pl As Range                     'déclare la variable pl (PLage)
Dim r As Range                      'déclare la variable r (Recherche)

  If Target.Count > 1 Then Exit Sub
  
  ' Si la modification a lieu dans la cellule A49 : Soit OUI/NON insertion ligne et on quitte la procédure
  If Target.Address = "$A$49" Then
    If MsgBox("Voulez-vous insérer 55 lignes ?", vbQuestion + vbYesNo) = vbYes Then
      Application.EnableEvents = False
      Rows(Target.Row & ":" & Target.Row + 55).Insert Shift:=xlShiftDown
      Application.EnableEvents = True
    End If
    Exit Sub
  End If
  
  ' Si la modification a lieu en A21:A106 ou en D21:D106
  If Not Intersect(Target, Range("A21:A106,D21:D106")) Is Nothing Then
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A21:A106")) Is Nothing Then           ' Modifications dans la colonne A
      Target = UCase(Target)
    
      If Target.Value = "" Then                                           ' On efface la donnée
        Target.Resize(1, 6).ClearContents
      Else                                                                ' Donc une nouvelle donnée
        With Sheets("Fournisseurs")                                       ' Prend en compte l'onglet "Fournisseurs"
          Set pl = .Range("A2:A" & .Range("A65536").End(xlUp).Row)        ' Définit la plage de recherche
        End With                                                          ' Fin de la prise en compte de l'onglet "Fournisseurs"
     
        Set r = pl.Find(Target.Value, , xlValues, xlWhole)                ' Définit la recherche
        If r Is Nothing Then                                              ' Si pas trouvé on sort
          MsgBox "Code non trouvé !"                                      ' Message
          Application.EnableEvents = True
          Exit Sub
        End If
      
      
        'place le résultat en B,C,E
        Target.Offset(0, 1).Value = r.Offset(0, 1).Value
        Target.Offset(0, 2).Value = r.Offset(0, 2).Value
        Target.Offset(0, 4).Value = r.Offset(0, 4).Value
        
        Cells(Target.Row, 4) = InputBox("Saisir Quantité")
      End If
    End If
    '
    ' Soit Modif en colonne A soit uniquement modif en colonne D
    '
    Cells(Target.Row, 6).Value = IIf(Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value = 0, "", _
                                     Cells(Target.Row, 4).Value * Cells(Target.Row, 5).Value)
    With Range("D:D")
      Set r = .Find(what:="T.V.A", LookIn:=xlValues, lookat:=xlWhole)
      If Not r Is Nothing Then
        r(0, 3) = Application.WorksheetFunction.Sum(Range("F21:F" & (r.Row - 2)))   ' Montant H.T
        r(1, 3) = r(0, 3) * r(1, 2)                                                 ' Montant T.V.A
        r(2, 3) = r(0, 3) * r(1, 3)                                                 ' Montant T.T.C
      End If
    End With
    Application.EnableEvents = True
  End If
End Sub

Bonne journée
 

Statistiques des forums

Discussions
312 294
Messages
2 086 880
Membres
103 404
dernier inscrit
sultan87