XL 2016 MSGBOX en double

Aldonanou

XLDnaute Junior
Bonjour,

Dans le cas de suivi de production, il est nécessaire, lors de la suppression d'un enregistrement sur l'onglet ArchivesA d'en avoir une copie sur l'onglet Suppression Accueil. Et ensuite de supprimer la ligne sélectionnée initialement de l'onglet ArchivesA pour que les enregistrements suivants se positionnent à la suite (action via un Userform).

J'ai bien le message "Cette référence n'existe pas !" lorsque la valeur n'est pas trouvée. Par contre, bien que l'information remonte avec "Enregistrement supprimé" pour une valeur trouvée + supprimée, la procédure m'affiche aussi "Cette référence n'existe pas !. Il y a certainement quelque chose qui manque.

Je n'arrive pas à trouver de solutions malgré toutes les recherches effectuées.

Quelqu'un pourrait-il me venir en aide. Merci

Bien cordialement

Ci-après le code utilisé

Private Sub SuppEnregA_Click()

Dim xRange As Range
Dim I As Long 'valeur dernière ligne active onglet ArchivesA
Dim J As Long 'valeur dernière ligne active onglet Suppression Accueil
Dim K As Long
Dim G As Long
Dim Ref As Long

I = Worksheets("ArchivesA").UsedRange.Rows.Count 'Nombre de ligne utilisées onglet ArchivesA
J = Worksheets("Suppression Accueil").UsedRange.Rows.Count 'nombre de ligne utilisées onglet Suppression Accueil
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Suppression Accueil").UsedRange) = 0 Then J = 0
End If
Set xRange = Worksheets("ArchivesA").Range("B2:B" & I)
On Error Resume Next
Application.ScreenUpdating = False

Ref = InputBox("Référence de l'enregistrement à supprimer ?")
For K = 1 To xRange.Count

If xRange(K) = Ref Then
xRange(K).EntireRow.Copy Destination:=Worksheets("Suppression Accueil").Range("A" & J + 1)
xRange(K).EntireRow.Delete

' Suppression de la ligne vide (ancienne référence) de l'onglet ArchivesA et ajout à l'onglet Suppression Accueil
If xRange(K) = Ref Then
K = K - 1
End If
J = J + 1
intpout = MsgBox("Enregistrement supprimé", vbInformation, "")
End If
Next


' Cette partie fonctionne sans le message
If xRange(G) <> Ref Then 'Exit Sub
MsgBox "Cette référence n'existe pas !"""
Exit Sub
End If

Application.ScreenUpdating = True

End Sub
 
Solution
Bonjour,

Dans le cas de suivi de production, il est nécessaire, lors de la suppression d'un enregistrement sur l'onglet ArchivesA d'en avoir une copie sur l'onglet Suppression Accueil. Et ensuite de supprimer la ligne sélectionnée initialement de l'onglet ArchivesA pour que les enregistrements suivants se positionnent à la suite (action via un Userform).

J'ai bien le message "Cette référence n'existe pas !" lorsque la valeur n'est pas trouvée. Par contre, bien que l'information remonte avec "Enregistrement supprimé" pour une valeur trouvée + supprimée, la procédure m'affiche aussi "Cette référence n'existe pas !. Il y a certainement quelque chose qui manque.

Je n'arrive pas à trouver de solutions malgré toutes les recherches...

M12

XLDnaute Accro
Bonjour,

Dans le cas de suivi de production, il est nécessaire, lors de la suppression d'un enregistrement sur l'onglet ArchivesA d'en avoir une copie sur l'onglet Suppression Accueil. Et ensuite de supprimer la ligne sélectionnée initialement de l'onglet ArchivesA pour que les enregistrements suivants se positionnent à la suite (action via un Userform).

J'ai bien le message "Cette référence n'existe pas !" lorsque la valeur n'est pas trouvée. Par contre, bien que l'information remonte avec "Enregistrement supprimé" pour une valeur trouvée + supprimée, la procédure m'affiche aussi "Cette référence n'existe pas !. Il y a certainement quelque chose qui manque.

Je n'arrive pas à trouver de solutions malgré toutes les recherches effectuées.

Quelqu'un pourrait-il me venir en aide. Merci

Bien cordialement

Ci-après le code utilisé

Private Sub SuppEnregA_Click()

Dim xRange As Range
Dim I As Long 'valeur dernière ligne active onglet ArchivesA
Dim J As Long 'valeur dernière ligne active onglet Suppression Accueil
Dim K As Long
Dim G As Long
Dim Ref As Long

I = Worksheets("ArchivesA").UsedRange.Rows.Count 'Nombre de ligne utilisées onglet ArchivesA
J = Worksheets("Suppression Accueil").UsedRange.Rows.Count 'nombre de ligne utilisées onglet Suppression Accueil
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Suppression Accueil").UsedRange) = 0 Then J = 0
End If
Set xRange = Worksheets("ArchivesA").Range("B2:B" & I)
On Error Resume Next
Application.ScreenUpdating = False

Ref = InputBox("Référence de l'enregistrement à supprimer ?")
For K = 1 To xRange.Count

If xRange(K) = Ref Then
xRange(K).EntireRow.Copy Destination:=Worksheets("Suppression Accueil").Range("A" & J + 1)
xRange(K).EntireRow.Delete

' Suppression de la ligne vide (ancienne référence) de l'onglet ArchivesA et ajout à l'onglet Suppression Accueil
If xRange(K) = Ref Then
K = K - 1
End If
J = J + 1
intpout = MsgBox("Enregistrement supprimé", vbInformation, "")
End If
Next


' Cette partie fonctionne sans le message
If xRange(G) <> Ref Then 'Exit Sub
MsgBox "Cette référence n'existe pas !"""
Exit Sub
End If

Application.ScreenUpdating = True

End Sub
Bonjour,
Rajoute un Exit Sub après ton Intput

VB:
' Suppression de la ligne vide (ancienne référence) de l'onglet ArchivesA et ajout à l'onglet Suppression Accueil
If xRange(K) = Ref Then
K = K - 1
End If
J = J + 1
intput = MsgBox("Enregistrement supprimé", vbInformation, "")
Exit Sub
End If

Next
 

Aldonanou

XLDnaute Junior
Bonjour,
Rajoute un Exit Sub après ton Intput

VB:
' Suppression de la ligne vide (ancienne référence) de l'onglet ArchivesA et ajout à l'onglet Suppression Accueil
If xRange(K) = Ref Then
K = K - 1
End If
J = J + 1
intput = MsgBox("Enregistrement supprimé", vbInformation, "")
Exit Sub
End If

Next
Bonjour M12,

Merci pour le retour. C'est impeccable, cela fonctionne à merveille.

Cordialement
 

Statistiques des forums

Discussions
311 540
Messages
2 080 523
Membres
101 234
dernier inscrit
Layani89