Remplacer la ligne

tactic6 · 13 Octobre 2010

Bonsoir le forum
Quelqu'un pourrait il m'aider à finir ce code ?

Code:

[COLOR="DarkGreen"]**********Gestion des doublons[/COLOR]
tabloFacture = f2.Range("C1:C" & Derli).Value
[COLOR="DarkGreen"]**********si doublon, affichage du message[/COLOR] 
If Not IsError(Application.Match(tablo(1, 3), tabloFacture, 0)) Then _
Mareponse = MsgBox("Le Numéro existe déjà. Voulez vous le remplacer ?", vbYesNo, "Remplacement")
If Mareponse = vbNo Then Exit Sub
If Mareponse = vbYes then
[COLOR="DarkRed"]ici il me manque le bout de code pour remplacer la ligne qui existe déjà[/COLOR]
?
?
Else
[COLOR="DarkGreen"]**********'insertion des données sur Recap_Facture[/COLOR]
Derli = Derli + 1
f2.Cells(Derli, "I").Value = T3
f2.Range("A" & Derli & ":F" & Derli).Value = tablo
...

Merci pour votre aide
Bonne soirée à tous

Pierrot93 · 14 Octobre 2010

Re : Remplacer la ligne

Bonjour,

qu'entends tu pas :

ici il me manque le bout de code pour remplacer la ligne qui existe déjà

difficile de travailler avec un bout de code jeté sur un post et si peu d'explication... allez au hasard essaye "delete"...

bonne journée
@+

tactic6 · 14 Octobre 2010

Re : Remplacer la ligne

Bonjour le forum, Pierrot93
merci de t'etre penché sur ma question
Voici le code entier

Code:

Sub Enregistrer_Devis()
Application.ScreenUpdating = False
Worksheets("SAISIE").Select
Worksheets("SAISIE").Unprotect

Dim Table() As String
Dim tablo(1, 6)
Dim tabloErreur As Variant
Dim tabloMsg As Variant
Dim tabloFacture As Variant
Dim msg As String
Dim msg1 As String
Dim msg2 As String
Dim f1  As Worksheet
Dim f2 As Worksheet
Dim Derli As Long
Dim i As Integer
If ActiveSheet.Range("g6").Value = "FACTURE N°" Then
    MsgBox " cette feuille est une FACTURE, vous ne pouvez l'enregistrer"
    Worksheets("SAISIE").Protect
    End
    Else
[COLOR="Green"] 'initialisation des variables[/COLOR]
Set f1 = Sheets("SAISIE")
Set f2 = Sheets("Recap_Devis")
[COLOR="Green"] ' affectaction des valeurs de cellules au tableau[/COLOR]
tablo(1, 1) = f1.[C12] [COLOR="Green"]'..........Code Client[/COLOR]
tablo(1, 2) = f1.[I5]    [COLOR="Green"]'..........Date[/COLOR]
tablo(1, 3) = f1.[J6]    [COLOR="Green"]'..........Numéro de la piece[/COLOR]
tablo(1, 4) = f1.[G8]    [COLOR="Green"]'.........Nom du Client[/COLOR]
tablo(1, 5) = f1.[H12]   [COLOR="Green"]'........Code Postal[/COLOR]
tablo(1, 6) = f1.[j59]    [COLOR="Green"] '........Total TTC[/COLOR]
[COLOR="Green"]'Gestion des cellules non renseignées[/COLOR]
tabloErreur = Array("", "Date", "")
tabloMsg = Array("nom", "date", "numéro")
msg1 = "Il n'y a pas de "
msg2 = ", le DEVIS ne peut pas être enregistrée."
[COLOR="Green"]'boucle pour l'affichage des cellules non remplies[/COLOR]
For i = 3 To 1 Step -1
   If tablo(1, i) = tabloErreur(i) Then msg = msg & vbLf & msg1 & tabloMsg(i) & msg2
Next i
[COLOR="Green"]'si une condition remplie, affichage du message d'erreur et fin de Sub[/COLOR]
If Not msg = "" Then MsgBox msg: Exit Sub
[COLOR="Green"]' controle ligne TVA[/COLOR]
For i = 15 To 52
  If f1.Cells(i, "J").Value <> "" And _
      f1.Cells(i, "K").Value = "" Then _
         MsgBox "la cellule " & Cells(i, "K").Address & " est vide.": End
Next i
[COLOR="Green"]'Recherche  de la dernière ligne de l'onglet "Recap_Devis"[/COLOR]
Derli = f2.Columns("A").Find("*", , , , , xlPrevious).Row ' + 1

[COLOR="Green"]'Gestion des doublons[/COLOR]
tabloFacture = f2.Range("C1:C" & Derli).Value
[COLOR="Green"]'si doublon, affichage du message et fin de Sub[/COLOR]  [COLOR="Blue"]Plutôt qu'un Exit Sub j'aimerais pouvoir modifier la ligne existante dans l'onglet Recap_Devis[/COLOR]
[COLOR="DarkRed"]If Not IsError(Application.Match(tablo(1, 3), tabloFacture, 0)) Then _
   MsgBox "Le numéro du DEVIS """ & tablo(1, 3) & """ existe déja!": Exit Sub[/COLOR]

[COLOR="Green"]'insertion des données sur Recap_Facture[/COLOR]
Derli = Derli + 1
f2.Cells(Derli, "I").Value = Now
f2.Range("A" & Derli & ":F" & Derli).Value = tablo

La ligne de code en rouge détecte les doublons pour éviter de donner 2 fois ou plus le même numéro à un devis
Plutôt qu'un END SUB j'aimerai un MsgBox qui me demande si oui ou non je veux écraser la ligne existante si le numéro existe déjà

Merci et bonne journée

Pierrot93 · 14 Octobre 2010

Re : Remplacer la ligne

Re,

tu dis ceci :

Plutôt qu'un END SUB j'aimerai un MsgBox qui me demande si oui ou non je veux écraser la ligne existante si le numéro existe déjà

et dans ton code, en commentaire il y a cela :

Plutôt qu'un Exit Sub j'aimerais pouvoir modifier la ligne existante dans l'onglet Recap_Devis

c'est pas la même chose....

Banzai64 · 14 Octobre 2010

Re : Remplacer la ligne

Bonjour tactic6, Pierrot93 et le forum

sans conviction car sans fichier test

Modifications en rouge

Code:

Sub Enregistrer_Devis()
Application.ScreenUpdating = False
Worksheets("SAISIE").Select
Worksheets("SAISIE").Unprotect

Dim Table() As String
Dim tablo(1, 6)
Dim tabloErreur As Variant
Dim tabloMsg As Variant
Dim tabloFacture As Variant
Dim msg As String
Dim msg1 As String
Dim msg2 As String
Dim f1  As Worksheet
Dim f2 As Worksheet
Dim Derli As Long
Dim i As Integer
[COLOR="Red"]Dim Lg[/COLOR]
  If ActiveSheet.Range("g6").Value = "FACTURE N°" Then
      MsgBox " cette feuille est une FACTURE, vous ne pouvez l'enregistrer"
      Worksheets("SAISIE").Protect
      End
      Else
   
   'initialisation des variables
  Set f1 = Sheets("SAISIE")
  Set f2 = Sheets("Recap_Devis")
   
   ' affectaction des valeurs de cellules au tableau
  tablo(1, 1) = f1.[C12] '..........Code Client
  tablo(1, 2) = f1.[I5]    '..........Date
  tablo(1, 3) = f1.[J6]    '..........Numéro de la piece
  tablo(1, 4) = f1.[G8]    '.........Nom du Client
  tablo(1, 5) = f1.[H12]   '........Code Postal
  tablo(1, 6) = f1.[j59]     '........Total TTC
  
  'Gestion des cellules non renseignées
  tabloErreur = Array("", "Date", "")
  tabloMsg = Array("nom", "date", "numéro")
  msg1 = "Il n'y a pas de "
  msg2 = ", le DEVIS ne peut pas être enregistrée."
  
  'boucle pour l'affichage des cellules non remplies
  For i = 3 To 1 Step -1
     If tablo(1, i) = tabloErreur(i) Then msg = msg & vbLf & msg1 & tabloMsg(i) & msg2
  Next i
  
  'si une condition remplie, affichage du message d'erreur et fin de Sub
  If Not msg = "" Then MsgBox msg: Exit Sub
  
  ' controle ligne TVA
  For i = 15 To 52
    If f1.Cells(i, "J").Value <> "" And _
        f1.Cells(i, "K").Value = "" Then _
           MsgBox "la cellule " & Cells(i, "K").Address & " est vide.": End
  Next i
  
  'Recherche  de la dernière ligne de l'onglet "Recap_Devis"
  Derli = f2.Columns("A").Find("*", , , , , xlPrevious).Row ' + 1
  
  'Gestion des doublons
  tabloFacture = f2.Range("C1:C" & Derli).Value
  
  'si doublon, affichage du message et fin de Sub  Plutôt qu'un Exit Sub j'aimerais pouvoir modifier la ligne existante dans l'onglet Recap_Devis
 [COLOR="Red"]' If Not IsError(Application.Match(tablo(1, 3), tabloFacture, 0)) Then _
     MsgBox "Le numéro du DEVIS """ & tablo(1, 3) & """ existe déja!": Exit Sub
  
  Lg = Application.Match(tablo(1, 3), tabloFacture, 0)
  
  ' Si erreur : Pas de doublon
  ' sinon Lg contient la ligne en double
  '
  If Not IsError(Lg) Then
    If MsgBox("Le numéro du DEVIS """ & tablo(1, 3) & """ existe déja!" & vbCr & "Voulez vous modifier la ligne ?", _
            vbInformation + vbYesNo, "Doublon détecté") = vbYes Then
      Derli = Lg - 1          ' On note - 1 car dans la suite tu rajoutes 1
    End If
  End If[/COLOR]
  
  'insertion [COLOR="Red"]ou modification[/COLOR] des données sur Recap_Facture
  Derli = Derli + 1
  f2.Cells(Derli, "I").Value = Now
  f2.Range("A" & Derli & ":F" & Derli).Value = tablo
End Sub

si je ma trompé --> Désolé

tactic6 · 14 Octobre 2010

Re : Remplacer la ligne

Le forum, le fil , Pierrot, Banzai
En modifiant le code de Banzai j'obtiens exactement ce que je désire
Voici le code modifié:

Code:

Sub Enregistrer_Devis()
Application.ScreenUpdating = False
Worksheets("SAISIE").Select
Worksheets("SAISIE").Unprotect

Dim Table() As String
Dim tablo(1, 6)
Dim tabloErreur As Variant
Dim tabloMsg As Variant
Dim tabloFacture As Variant
Dim msg As String
Dim msg1 As String
Dim msg2 As String
Dim f1  As Worksheet
Dim f2 As Worksheet
Dim Derli As Long
Dim i As Integer
Dim Lg
  If ActiveSheet.Range("g6").Value = "FACTURE N°" Then
      MsgBox " cette feuille est une FACTURE, vous ne pouvez l'enregistrer"
      Worksheets("SAISIE").Protect
      End
      Else
   
   'initialisation des variables
  Set f1 = Sheets("SAISIE")
  Set f2 = Sheets("Recap_Devis")
   
   ' affectaction des valeurs de cellules au tableau
  tablo(1, 1) = f1.[C12] '..........Code Client
  tablo(1, 2) = f1.[I5]    '..........Date
  tablo(1, 3) = f1.[J6]    '..........Numéro de la piece
  tablo(1, 4) = f1.[G8]    '.........Nom du Client
  tablo(1, 5) = f1.[H12]   '........Code Postal
  tablo(1, 6) = f1.[j59]     '........Total TTC
  
  'Gestion des cellules non renseignées
  tabloErreur = Array("", "Date", "")
  tabloMsg = Array("nom", "date", "numéro")
  msg1 = "Il n'y a pas de "
  msg2 = ", le DEVIS ne peut pas être enregistrée."
  
  'boucle pour l'affichage des cellules non remplies
  For i = 3 To 1 Step -1
     If tablo(1, i) = tabloErreur(i) Then msg = msg & vbLf & msg1 & tabloMsg(i) & msg2
  Next i
  
  'si une condition remplie, affichage du message d'erreur et fin de Sub
  If Not msg = "" Then MsgBox msg: Exit Sub
  
  ' controle ligne TVA
  For i = 15 To 52
    If f1.Cells(i, "J").Value <> "" And _
        f1.Cells(i, "K").Value = "" Then _
           MsgBox "la cellule " & Cells(i, "K").Address & " est vide.": End
  Next i
  
  'Recherche  de la dernière ligne de l'onglet "Recap_Devis"
  Derli = f2.Columns("A").Find("*", , , , , xlPrevious).Row ' + 1
  
  'Gestion des doublons
  tabloFacture = f2.Range("C1:C" & Derli).Value
  
  'si doublon, affichage du message et fin de Sub  Plutôt qu'un Exit Sub j'aimerais pouvoir modifier la ligne existante dans l'onglet Recap_Devis
 ' If Not IsError(Application.Match(tablo(1, 3), tabloFacture, 0)) Then _
     MsgBox "Le numéro du DEVIS """ & tablo(1, 3) & """ existe déja!": Exit Sub
  
  Lg = Application.Match(tablo(1, 3), tabloFacture, 0)
  
  ' Si erreur : Pas de doublon
  ' sinon Lg contient la ligne en double
  '
  If Not IsError(Lg) Then
    Mareponse = MsgBox("Le Numéro existe déjà. Voulez vous le remplacer ?", vbYesNo, "Remplacement")
           
           If Mareponse = vbNo Then Exit Sub
           If Mareponse = vbYes Then
      Derli = Lg - 1          ' On note - 1 car dans la suite tu rajoutes 1
        End If
  End If
End Sub

Merci encore à tous les participants et bonne journée

tactic6 · 14 Octobre 2010

Re : Remplacer la ligne

Re tout le monde
Je croyais pouvoir comprendre le code ci dessus et le modifier pour continuer la seconde partie de mon projet mais je bloc sur ces codes que décidément j'ai du mal a comprendre
je voudrais pouvoir enregistrer les sauvegardes
ça c'est OK le code le permet
mais j'aimerais que maintenant si un numéro existe déjà en colonne A de la feuille d'archivage l'écriture se fasse par dessus et écrase l'ancienne .
Je vous joint un petit fichier
Encore merci

Banzai64 · 14 Octobre 2010

Re : Remplacer la ligne

Bonsoir

Pas sur d'avoir tout compris

mais si tu utilises le même principe que l'autre macro il n'y devrait pas y avoir de problème

Sub Enregistrer_Devis()
Application.ScreenUpdating = False
Worksheets("SAISIE").Select
Worksheets("SAISIE").Unprotect

Dim Table() As String
Dim tablo(1, 6)
Dim tabloErreur As Variant
Dim tabloMsg As Variant
Dim tabloFacture As Variant
Dim msg As String
Dim msg1 As String
Dim msg2 As String
Dim f1 As Worksheet
Dim f2 As Worksheet
Dim Derli As Long
Dim i As Integer
Dim Lg
If ActiveSheet.Range("g6").Value = "FACTURE N°" Then
MsgBox " cette feuille est une FACTURE, vous ne pouvez l'enregistrer"
Worksheets("SAISIE").Protect
End
Else

'initialisation des variables
Set f1 = Sheets("SAISIE")
' Modifies la feuille de destination
Set f2 = Sheets("Recap_Devis")

' affectaction des valeurs de cellules au tableau
tablo(1, 1) = f1.[C12] '..........Code Client
tablo(1, 2) = f1.[I5] '..........Date
tablo(1, 3) = f1.[J6] '..........Numéro de la piece
tablo(1, 4) = f1.[G8] '.........Nom du Client
tablo(1, 5) = f1.[H12] '........Code Postal
tablo(1, 6) = f1.[j59] '........Total TTC

'Gestion des cellules non renseignées
tabloErreur = Array("", "Date", "")
tabloMsg = Array("nom", "date", "numéro")
msg1 = "Il n'y a pas de "
msg2 = ", le DEVIS ne peut pas être enregistrée."

'boucle pour l'affichage des cellules non remplies
For i = 3 To 1 Step -1
If tablo(1, i) = tabloErreur(i) Then msg = msg & vbLf & msg1 & tabloMsg(i) & msg2
Next i

'si une condition remplie, affichage du message d'erreur et fin de Sub
If Not msg = "" Then MsgBox msg: Exit Sub

' controle ligne TVA
For i = 15 To 52
If f1.Cells(i, "J").Value <> "" And _
f1.Cells(i, "K").Value = "" Then _
MsgBox "la cellule " & Cells(i, "K").Address & " est vide.": End
Next i

'Recherche de la dernière ligne de l'onglet "Recap_Devis"
Derli = f2.Columns("A").Find("*", , , , , xlPrevious).Row ' + 1

'Gestion des doublons
' Détermine la colonne à tester
tabloFacture = f2.Range("C1:C" & Derli).Value

'si doublon, affichage du message et fin de Sub Plutôt qu'un Exit Sub j'aimerais pouvoir modifier la ligne existante dans l'onglet Recap_Devis
' If Not IsError(Application.Match(tablo(1, 3), tabloFacture, 0)) Then _
MsgBox "Le numéro du DEVIS """ & tablo(1, 3) & """ existe déja!": Exit Sub

Lg = Application.Match(tablo(1, 3), tabloFacture, 0)

' Si erreur : Pas de doublon
' sinon Lg contient la ligne en double
'
If Not IsError(Lg) Then

' Comme tu veux remplacer la ligne si elle existe pas la peine de poser la question
' If MsgBox("Le numéro du DEVIS """ & tablo(1, 3) & """ existe déja!" & vbCr & "Voulez vous modifier la ligne ?", _
vbInformation + vbYesNo, "Doublon détecté") = vbYes Then
Derli = Lg - 1 ' On note - 1 car dans la suite tu rajoutes 1
' End If
End If

'insertion ou modification des données sur Recap_Facture
Derli = Derli + 1
f2.Cells(Derli, "I").Value = Now
f2.Range("A" & Derli & ":F" & Derli).Value = tablo

si pas ça fournit un fichier un peut plus explicite (Surtout pour moi)

tactic6 · 14 Octobre 2010

Re : Remplacer la ligne

Re Banzai et merci pour ton intérêt
Sur le fichier joint on saisit un numéro en I6
J'aimerai que quand je clic sur le bouton transfert, si le numéro est déjà présent sur la feuille ShArchive1 le nouvel enregistrement remplace l'ancien
Comme tu peux le voir dans la feuille ShArchive1 il y a plusieurs N° 24 et N° 25
c'est cela que je veux éviter

En concret:
je crée des devis à des clients et quelques fois il faut les modifier
plutôt que d'en recréer un autre je le reprend, le modifie et le ré-enregistre et je ne veux avoir sur ma feuille que la dernière version

Ceci est une partie indépendante du premier post que tu as déjà résolue et t'en remercie encore une fois

Merci

Banzai64 · 15 Octobre 2010

Re : Remplacer la ligne

Bonjour

Si j'ai compris le problème

tactic6 · 15 Octobre 2010

Re : Remplacer la ligne

Bonjour
Merci Banzai c'est exactement ce que je recherchais
Par contre pour ta remarque sur la fin du code je dois t'avouer que je ne sais pas.
je vais essayer de le supprimer sur mon fichier complet pour voir ce que ça donne
Je te remercie énormément
Bonne journée

Remplacer la ligne

tactic6

XLDnaute Impliqué

Pierrot93

XLDnaute Barbatruc

tactic6

XLDnaute Impliqué

Pierrot93

XLDnaute Barbatruc

Banzai64

XLDnaute Accro

tactic6

XLDnaute Impliqué

tactic6

XLDnaute Impliqué

Pièces jointes

Banzai64

XLDnaute Accro

tactic6

XLDnaute Impliqué

Pièces jointes

Banzai64

XLDnaute Accro

Pièces jointes

tactic6

XLDnaute Impliqué

Discussions similaires

Remplacer la ligne

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

XLDnaute Accro

XLDnaute Impliqué

Pièces jointes

XLDnaute Accro

Pièces jointes

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency