XL 2016 Insérer MsgBox YesNoCancel dans une macro

YANNISE

XLDnaute Nouveau
bonjour Forum,

Je souhaite que vous m'apportiez vos savoirs sur un blocage au niveau de l'insertion d'une MsgBox dans ma macro
Je voulais si la réponse est oui alors les valeurs seront copies
Mais sinon la cellule de saisie D1 sera effacée et sortie de la macro
Est si Annuler sortir de la MsgBox sans rien faire (la valeur sur D1 ne va pas être effacée)
Mais si une valeur n'est pas présente dans la base de données, la macro ne va pas intervenir
Avant d'insert la MsgBox ma macro marche parfaitement
ci-dessous le code VBA avec le fichier ci-joint

d'avance, merci pour votre aide

VB:
Sub Test_vr()

Dim ws_1 As Worksheet
Dim ws_2 As Worksheet
Dim Valeur_Test As String
Dim DerniereLigne As Integer
Dim Lig

Set ws_1 = Worksheets(1)
Set ws_2 = Worksheets(2)

Valeur_Test = ws_1.Cells(1, 4).Value

DerniereLigne = ws_2.Cells(65536, 4).End(xlUp).Row

Set Rech = ws_2.Columns(4).Find(Valeur_Test)

If Not Rech Is Nothing Then
        Lig = Rech.Row
End If

  ws_2.Range(ws_2.Cells(Lig, 1), ws_2.Cells(Lig, 1)).Copy ws_1.Cells(15, 2)
  ws_2.Range(ws_2.Cells(Lig, 2), ws_2.Cells(Lig, 2)).Copy ws_1.Cells(15, 4)
  ws_2.Range(ws_2.Cells(Lig, 3), ws_2.Cells(Lig, 3)).Copy ws_1.Cells(18, 3)
  ws_2.Range(ws_2.Cells(Lig, 5), ws_2.Cells(Lig, 5)).Copy ws_1.Cells(18, 5)
      
End Sub
 

Pièces jointes

  • V2.00_VBA_REF_EXISTE.xlsm
    20.6 KB · Affichages: 3

patricktoulon

XLDnaute Barbatruc
Bonjour

VB:
Sub Test_vr()
if msgbox ("voulez vous copier blablabla  blablabla",vbyesno)= vbyes then
Dim ws_1 As Worksheet
Dim ws_2 As Worksheet
Dim Valeur_Test As String
Dim DerniereLigne As Integer
Dim Lig

Set ws_1 = Worksheets(1)
Set ws_2 = Worksheets(2)

Valeur_Test = ws_1.Cells(1, 4).Value

DerniereLigne = ws_2.Cells(65536, 4).End(xlUp).Row

Set Rech = ws_2.Columns(4).Find(Valeur_Test)

If Not Rech Is Nothing Then
        Lig = Rech.Row
End If

  ws_2.Range(ws_2.Cells(Lig, 1), ws_2.Cells(Lig, 1)).Copy ws_1.Cells(15, 2)
  ws_2.Range(ws_2.Cells(Lig, 2), ws_2.Cells(Lig, 2)).Copy ws_1.Cells(15, 4)
  ws_2.Range(ws_2.Cells(Lig, 3), ws_2.Cells(Lig, 3)).Copy ws_1.Cells(18, 3)
  ws_2.Range(ws_2.Cells(Lig, 5), ws_2.Cells(Lig, 5)).Copy ws_1.Cells(18, 5)
 end if
 End Sub
 

patricktoulon

XLDnaute Barbatruc
re
a ben c'est une sub elle est bien déclenchée par quelque chose

c'est dans l'event change alors qu'il faut traiter l'opération

il faut être un plus precis sur le contexte de votre problème sinon un truc qui prend 2 secondes va prendre des plombes;)
 

YANNISE

XLDnaute Nouveau
Ca marche pas votre solution, car au début ma macro se déclenche une fois une valeur double est saisie
Cependant je voulais ajouter le msgbox s’affiche pour les trois boutant
Oui = extraire
Non = effacer la cellule D1 est quitter la sub
Annuler = exit sub

Pour votre proposition si je le mets sur private sub worksheet_change ca va s’exécuter a chaque changent de valeur sur la cellule même si la valeur n’ai pas doublon ainsi qaund je fait non D1 est effacé mais le msgbox reste affiché

Merci
 

Discussions similaires

Réponses
9
Affichages
377

Statistiques des forums

Discussions
299 938
Messages
1 980 234
Membres
207 037
dernier inscrit
Cld.