Controle Activex avec case à cocher et Mgsbox YES/NO

Bonjour à tous,

je suis à la fin de mon projet Macro mais j'aurai besoin de votre aide.

J'ai créé des boutons case à cocher (Activex) pour déclencher mes Macros avec une demande de confirmation par MsgBox (Yes/No).

Je voudrais en cas de réponse négative effacer la coche dans mon bouton.

Voici ma macro ci-dessous.

Si une âme charitable pouvait m'aider çà serait super sympa.

Merci olivier

Private Sub MODIFICATION_Click()

If MsgBox("Voulez-vous envoyer cette modification ?", vbQuestion + vbYesNo, "C'EST TA DERNIERE CHANCE ;-)))") = vbYes Then

Range("T1:W1").Select
ActiveCell.FormulaR1C1 = "VIERGE"
Range("T1:W1").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Sheets("VIERGE")
.Range("A1:F3").Copy
Range("A1:F3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
End With

'Fonctionne sous excel 2000-2013
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copie la feuille active comme nouvelle feuille

ActiveSheet.Copy
Set destwb = ActiveWorkbook

'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
'----------------------------------------------------------------------------

TempFilePath = "C:\Temp\"
TempFileName = Sheets("VIERGE").Cells(1, 1).Value & " " & Sheets("VIERGE").Cells(3, 6).Value & " " & Sheets("VIERGE").Cells(2, 6).Value
DateSortie = Sheets("VIERGE").Cells(2, 6).Value
NombreServeur = Sheets("VIERGE").Cells(11, 6).Value
NombreCuisinier = Sheets("VIERGE").Cells(12, 6).Value
NombrePlongeur = Sheets("VIERGE").Cells(13, 6).Value

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf

On Error Resume Next
With OutMail
.To = "........@........"
.CC = ""
.bcc = ""
.Subject = "MODIFICATION RESERVATION SERVEUR(S)" & " " & TempFileName
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour ," & vbCrLf & vbCrLf & "voici une modification pour la réservation de " & NombreServeur & " serveur(s) et de " & NombreCuisinier & " cuisinier(s) et de " & NombrePlongeur & " plongeur(s) pour la fiche client " & TempFileName & " pour le " & DateSortie & "." & vbCrLf & vbCrLf & "Bien à toi," & vbCrLf & vbCrLf & "Service traiteur"
'.display 'ou alors utiliser
.Send 'pour envoi
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Else

Exit Sub

End If

End Sub

Edit modo

Bonjour Olivier,

Merci de mettre le code entre balise SVP, avec le bouton [</>] qui est fait pour ça

Sinon voici le code optimisé, dans lequel j'utilise un Flag pour éviter la boucle infini

Dim FlgExit As Boolean

Private Sub Modification_Click()
  'Fonctionne sous excel 2000-2013
  Dim FileExtStr As String
  Dim FileFormatNum As Long
  Dim Sourcewb As Workbook
  Dim DestWb As Workbook
  Dim TempFilePath As String
  Dim TempFileName As String
  Dim OutApp As Object
  Dim OutMail As Object
  Dim S As Shape
  Dim Sht As Worksheet

  ' Evite la boucle infernale
  If FlgExit Then FlgExit = False: Exit Sub
  ' Questtion
  If MsgBox("Voulez-vous envoyer cette modification ?", vbQuestion + vbYesNo, "C'EST TA DERNIERE CHANCE ;-)))") = vbNo Then
    FlgExit = True
    Me.Modification.Value = False
    Exit Sub
  End If

  With Range("T1:W1")
    .FormulaR1C1 = "VIERGE"
    With .Font
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
    End With
    With .Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
  End With
  ' Définir la feuille de travail
  Set Sht = Sheets("VIERGE")
  '
  Sht.Range("A1:F3").Copy
  Sht.Range("A1:F3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  '
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    'Désactiver fenêtre de compatibilité
    .DisplayAlerts = False
  End With
  '
  Set Sourcewb = ActiveWorkbook
  'Copie la feuille active comme nouvelle feuille
  ActiveSheet.Copy
  Set DestWb = ActiveWorkbook
  '----------------------------------------------------------------------------
  'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
  '----------------------------------------------------------------------------

  TempFilePath = "C:\Temp\"
  TempFileName = Sht.Cells(1, 1).Value & " " & Sht.Cells(3, 6).Value & " " & Sht.Cells(2, 6).Value
  DateSortie = Sht.Cells(2, 6).Value
  NombreServeur = Sht.Cells(11, 6).Value
  NombreCuisinier = Sht.Cells(12, 6).Value
  NombrePlongeur = Sht.Cells(13, 6).Value

  DestWb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf

  Set OutApp = CreateObject("outlook.application")
  Set OutMail = OutApp.CreateItem(0)
  On Error Resume Next
  With OutMail
    .To = "........@........"
    .CC = ""
    .bcc = ""
    .Subject = "MODIFICATION RESERVATION SERVEUR(S)" & " " & TempFileName
    .Attachments.Add TempFilePath & TempFileName & ".pdf"
    .Body = "Bonjour ," & vbCrLf & vbCrLf & "voici une modification pour la réservation de " & NombreServeur & " serveur(s) et de " & NombreCuisinier & " cuisinier(s) et de " & NombrePlongeur & " plongeur(s) pour la fiche client " & TempFileName & " pour le " & DateSortie & "." & vbCrLf & vbCrLf & "Bien à toi," & vbCrLf & vbCrLf & "Service traiteur"
    '.display 'ou alors utiliser
    .Send 'pour envoi
  End With
  On Error GoTo 0
  DestWb.Close savechanges:=False

  'Effacer le fichier envoyé
  Kill TempFilePath & TempFileName & ".pdf"

  Set OutMail = Nothing
  Set OutApp = Nothing

  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
  End With
End Sub

@+

Bonjour Bruno,

je te remercie sincèrement pour ton aide et pour le temps que tu as consacré.

ça fonctionne très bien , c'est parfait.

Bonne journée,

olivier

Bonjour Olivier,

@+