XL 2019 problème lors de l'exécution du code vba

Dadi147 · 1 Octobre 2022

Bonjour, lors de l'exécution du code, il copie les nouvelles données sur les anciennes, je ne sais pas pourquoi ?

VB:

Private Sub CommandButton10_Click()
If Me.txt_product.Value = "" Then
   MsgBox "attention", vbCritical
   Exit Sub
   End If
If IsNumeric(Me.txt_price_pru) = False Then
   MsgBox "attention svp", vbCritical
   Exit Sub
   End If
   If IsNumeric(Me.txt_price_sale) = False Then
   MsgBox "attention svp", vbCritical
   Exit Sub
   End If
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("product_master")
If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then
 MsgBox "value déjà"""", vbCritical
 Exit Sub
End If
Dim lr As Integer
lr = appliction.worksheetfuncion.CountA(sh.Range("A:A"))
sh.Range("A" & lr + 1).Value = lr
sh.Range("B" & lr + 1).Value = Me.txt_product.Value
sh.Range("C" & lr + 1).Value = Me.txt_price_sale.Value
sh.Range("D" & lr + 1).Value = Me.txt_price_pru.Value

Me.txt_product.Value = ""
Me.txt_price_sale.Value = ""
Me.txt_price_pru.Value = ""
MsgBox "Done", vbtnformation

Staple1600 · 1 Octobre 2022

Bonjour le fil,

@Dadi147
Petit conseil en passant
Toujours joindre un fichier exemple simplifié et anonymisé
(notamment quand il est question d'Userform)
1) Ca nous évite de reconstruire un fichier
2) C'est plus simple pour tout le monde

jpb388 · 2 Octobre 2022

bonjour à tous,staple1600
je pense que cela vient du counta
teste ceci

VB:

Private Sub CommandButton10_Click()
    Dim lr As Integer
    If Me.txt_product.Value = "" Then Err.Raise vbObjectError + 1
    If IsNumeric(Me.txt_price_pru) = False Then Err.Raise vbObjectError + 2
    If IsNumeric(Me.txt_price_sale) = False Then Err.Raise vbObjectError + 2
    If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then Err.Raise vbObjectError + 3
    lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    sh.Range("A" & lr).Value = lr
    sh.Range("B" & lr).Value = Me.txt_product.Value
    sh.Range("C" & lr).Value = Me.txt_price_sale.Value
    sh.Range("D" & lr).Value = Me.txt_price_pru.Value
    Me.txt_product.Value = ""
    Me.txt_price_sale.Value = ""
    Me.txt_price_pru.Value = ""
    MsgBox "Done", vbtnformation
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case vbObjectError + 1: MsgBox "attention ", vbCritical
        Case vbObjectError + 2: MsgBox "attention svp", vbCritical
        Case vbObjectError + 3: MsgBox "value déjà"""", vbCritical"
    End Select
End Sub

mapomme · 2 Octobre 2022

Bonjour @Dadi147 , @Staple1600 , @jpb388 ,

Essayez ce code (non testé puisque pas de classeur joint ):

Code:

   Dim lr As Long
   With sh
      If .FilterMode Then .ShowAllData           'pour que le END() fonctionne correctement!
      lr = .Cells(Rows.Count, "a").End(xlUp).Row + 1
      .Cells(lr, "a") = lr - 1
      .Cells(lr, "b") = Me.txt_product
      .Cells(lr, "c") = Me.txt_price_sale
      .Cells(lr, "d") = Me.txt_price_pru
   End With

Staple1600 · 2 Octobre 2022

Bonjour le fil

@mapomme
Je me permets (le temps que mon poisson finisse de cuire)
Ou Essayez ce code (testé ,car j'ai aussi mes courgettes à cuire )

VB:

Private Sub CommandButton1_Click()
Dim lr&
   With ActiveSheet
      If .FilterMode Then .ShowAllData           'pour que le END() fonctionne correctement!
      lr = .Cells(Rows.Count, 1).End(3).Row + 1
      Cells(lr, 1).Resize(, 4) = Array(lr - 1, txt_product, txt_price_sale, txt_price_pru)
   End With
End Sub

XL 2019 problème lors de l'exécution du code vba

Dadi147

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

jpb388

XLDnaute Accro

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires