Microsoft 365 MSG box avec deux options

  • Initiateur de la discussion Initiateur de la discussion Roseline
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Roseline

XLDnaute Occasionnel
Bonjour,
J'ai un fichier qui me permet d'envoyer des données automatiquement par courriel aux personnes concernées. J'ai besoin de votre aide car je cherche depuis un certain temps et je ne trouve pas de réponse à mon problème.
Avant d'ouvrir le courriel, je voudrais qu'un msg box affiche "Est-ce que c'est une mise à jour du dossier?". SI non, je veux que le sujet de mon courriel soit comment indiqué dans programmation actuellement c'est à dire qu'il va m'inscrire le résultat de ce qui est inscrit dans la cellule C3
.Subject = "Résultat - " & Worksheets("Feuil2").Range("C3").Value

Cependant, si la réponse est oui, je voudrais qu'au bout de ma cellule C3, le mot mise à jour s'ajoute

Je suis certaine qu'une personne pourra m'aider et je vous remercie à l'avance.

Bonne journée
 

Pièces jointes

Solution
Bonjour Roseline,

regarde tout le code VBA. (pas seulement la 1ère sub)

attention : c'est non testé ! (mais ça devrait aller)

pour la MsgBox, y'aura 2 boutons "Oui" et "Non" ; éventuellement, tu peux mettre aussi un 3ème bouton "Annuler" ; dans ce 3ème cas : Exit Sub pour sortir de la sub sans rien faire ; si ça te dit mais que tu as du mal à le faire, je pourrai t'aider. 🙂

autre suggestion : faire que le bouton par défaut soit celui de la réponse la plus courante ; exemple : si en pratique la réponse la plus courante est "Non" (ce n'est pas une mise à jour du...
Bonjour Roseline,

regarde tout le code VBA. (pas seulement la 1ère sub)

attention : c'est non testé ! (mais ça devrait aller)

pour la MsgBox, y'aura 2 boutons "Oui" et "Non" ; éventuellement, tu peux mettre aussi un 3ème bouton "Annuler" ; dans ce 3ème cas : Exit Sub pour sortir de la sub sans rien faire ; si ça te dit mais que tu as du mal à le faire, je pourrai t'aider. 🙂

autre suggestion : faire que le bouton par défaut soit celui de la réponse la plus courante ; exemple : si en pratique la réponse la plus courante est "Non" (ce n'est pas une mise à jour du dossier), alors c'est le 2ème bouton "Non" qui devra être le bouton par défaut, au lieu du 1er bouton "Oui" ; là aussi : si ça te dit mais qu'tu sais pas faire, j'pourrai t'aider. 🙂


code VBA :

VB:
Option Explicit

Sub sendMail()
  On Error Resume Next
  Dim xOutApp As Object, xOutMail As Object, xRg As Range
  Dim TempFilePath$, xHTMLBody$
  Set xRg = [B1:C11]: If xRg Is Nothing Then Exit Sub
 
  Dim rép%, sigstring$, signature$, f$
  sigstring = Environ("appdata") & "\Microsoft\Signatures\"
  f = Dir(sigstring & "*.htm")
  signature = getboiler(sigstring & f)
 
  Application.ScreenUpdating = 0
  Dim olMailItem As Object, olByValue As Object
  Set xOutApp = CreateObject("outlook.application")
  Set xOutMail = xOutApp.CreateItem(olMailItem)
 
  Call createJpg(ActiveSheet.Name, xRg.Address, "Résultat")
  TempFilePath = Environ$("Public") & "\"
  xHTMLBody = "<span LANG=EN>" _
    & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
    & "hi, <br><br>Please find....> <br>" & (xRg) & "<br><br>"
 
  rép = MsgBox("Est-ce une mise à jour du dossier ?", 4, "Question")
  With xOutMail
    If rép = 6 Then [C3] = [C3] & " - Mise à jour" _
      Else .Subject = "Résultat - " & [Feuil2!C3]
    .HTMLBody = xHTMLBody & signature
    .Attachments.Add TempFilePath & "Résultat.jpg", olByValue
    .To = "toto@hotmail.com"
    .Cc = "tati@hotmail.com"
    .Display
  End With
 
  Kill "C:\Users\Public\Résultat.jpg"
  Application.ScreenUpdating = -1
  Workbooks("Travail").Save
End Sub

Sub createJpg(SheetName$, xRgAddrss$, nameFile$)
  Dim xRgPic As Range, xShape As Shape
  ThisWorkbook.Activate: Worksheets(SheetName).Activate
  Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
  xRgPic.CopyPicture
  With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
    .Activate
    For Each xShape In ActiveSheet.Shapes
      xShape.Line.Visible = msoFalse
    Next
    .Chart.Paste: .Chart.Export Environ$("Public") & "\" & nameFile & ".jpg", "JPG"
  End With
  Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
  Set xRgPic = Nothing
End Sub

Function getboiler(fpath$) As String
  Dim fso As Object, ts As Object
  Set fso = CreateObject("scripting.filesystemobject")
  Set ts = fso.getfile(fpath).openastextstream(1, -2)
  getboiler = ts.readall: ts.Close
End Function

soan
 

Pièces jointes

Dernière édition:
Bonjour Roseline,

regarde tout le code VBA. (pas seulement la 1ère sub)

attention : c'est non testé ! (mais ça devrait aller)

pour la MsgBox, y'aura 2 boutons "Oui" et "Non" ; éventuellement, tu peux mettre aussi un 3ème bouton "Annuler" ; dans ce 3ème cas : Exit Sub pour sortir de la sub sans rien faire ; si ça te dit mais que tu as du mal à le faire, je pourrai t'aider. 🙂

autre suggestion : faire que le bouton par défaut soit celui de la réponse la plus courante ; exemple : si en pratique la réponse la plus courante est "Non" (ce n'est pas une mise à jour du dossier), alors c'est le 2ème bouton "Non" qui devra être le bouton par défaut, au lieu du 1er bouton "Oui" ; là aussi : si ça te dit mais qu'tu sais pas faire, j'pourrai t'aider. 🙂


code VBA :

VB:
Option Explicit

Sub sendMail()
  On Error Resume Next
  Dim xOutApp As Object, xOutMail As Object, xRg As Range
  Dim TempFilePath$, xHTMLBody$
  Set xRg = [B1:C11]: If xRg Is Nothing Then Exit Sub
 
  Dim rép%, sigstring$, signature$, f$
  sigstring = Environ("appdata") & "\Microsoft\Signatures\"
  f = Dir(sigstring & "*.htm")
  signature = getboiler(sigstring & f)
 
  Application.ScreenUpdating = 0
  Dim olMailItem As Object, olByValue As Object
  Set xOutApp = CreateObject("outlook.application")
  Set xOutMail = xOutApp.CreateItem(olMailItem)
 
  Call createJpg(ActiveSheet.Name, xRg.Address, "Résultat")
  TempFilePath = Environ$("Public") & "\"
  xHTMLBody = "<span LANG=EN>" _
    & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
    & "hi, <br><br>Please find....> <br>" & (xRg) & "<br><br>"
 
  rép = MsgBox("Est-ce une mise à jour du dossier ?", 4, "Question")
  With xOutMail
    If rép = 6 Then [C3] = [C3] & " - Mise à jour" _
      Else .Subject = "Résultat - " & [Feuil2!C3]
    .HTMLBody = xHTMLBody & signature
    .Attachments.Add TempFilePath & "Résultat.jpg", olByValue
    .To = "toto@hotmail.com"
    .Cc = "tati@hotmail.com"
    .Display
  End With
 
  Kill "C:\Users\Public\Résultat.jpg"
  Application.ScreenUpdating = -1
  Workbooks("Travail").Save
End Sub

Sub createJpg(SheetName$, xRgAddrss$, nameFile$)
  Dim xRgPic As Range, xShape As Shape
  ThisWorkbook.Activate: Worksheets(SheetName).Activate
  Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
  xRgPic.CopyPicture
  With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
    .Activate
    For Each xShape In ActiveSheet.Shapes
      xShape.Line.Visible = msoFalse
    Next
    .Chart.Paste: .Chart.Export Environ$("Public") & "\" & nameFile & ".jpg", "JPG"
  End With
  Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
  Set xRgPic = Nothing
End Sub

Function getboiler(fpath$) As String
  Dim fso As Object, ts As Object
  Set fso = CreateObject("scripting.filesystemobject")
  Set ts = fso.getfile(fpath).openastextstream(1, -2)
  getboiler = ts.readall: ts.Close
End Function

soan
C'est exactement ce que j'avais besoin, ton aide m'a été précieuse. Merci encore et je te souhaite une excellente journée. 😀
 
Bonjour Roseline,

regarde tout le code VBA. (pas seulement la 1ère sub)

attention : c'est non testé ! (mais ça devrait aller)

pour la MsgBox, y'aura 2 boutons "Oui" et "Non" ; éventuellement, tu peux mettre aussi un 3ème bouton "Annuler" ; dans ce 3ème cas : Exit Sub pour sortir de la sub sans rien faire ; si ça te dit mais que tu as du mal à le faire, je pourrai t'aider. 🙂

autre suggestion : faire que le bouton par défaut soit celui de la réponse la plus courante ; exemple : si en pratique la réponse la plus courante est "Non" (ce n'est pas une mise à jour du dossier), alors c'est le 2ème bouton "Non" qui devra être le bouton par défaut, au lieu du 1er bouton "Oui" ; là aussi : si ça te dit mais qu'tu sais pas faire, j'pourrai t'aider. 🙂


code VBA :

VB:
Option Explicit

Sub sendMail()
  On Error Resume Next
  Dim xOutApp As Object, xOutMail As Object, xRg As Range
  Dim TempFilePath$, xHTMLBody$
  Set xRg = [B1:C11]: If xRg Is Nothing Then Exit Sub
 
  Dim rép%, sigstring$, signature$, f$
  sigstring = Environ("appdata") & "\Microsoft\Signatures\"
  f = Dir(sigstring & "*.htm")
  signature = getboiler(sigstring & f)
 
  Application.ScreenUpdating = 0
  Dim olMailItem As Object, olByValue As Object
  Set xOutApp = CreateObject("outlook.application")
  Set xOutMail = xOutApp.CreateItem(olMailItem)
 
  Call createJpg(ActiveSheet.Name, xRg.Address, "Résultat")
  TempFilePath = Environ$("Public") & "\"
  xHTMLBody = "<span LANG=EN>" _
    & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
    & "hi, <br><br>Please find....> <br>" & (xRg) & "<br><br>"
 
  rép = MsgBox("Est-ce une mise à jour du dossier ?", 4, "Question")
  With xOutMail
    If rép = 6 Then [C3] = [C3] & " - Mise à jour" _
      Else .Subject = "Résultat - " & [Feuil2!C3]
    .HTMLBody = xHTMLBody & signature
    .Attachments.Add TempFilePath & "Résultat.jpg", olByValue
    .To = "toto@hotmail.com"
    .Cc = "tati@hotmail.com"
    .Display
  End With
 
  Kill "C:\Users\Public\Résultat.jpg"
  Application.ScreenUpdating = -1
  Workbooks("Travail").Save
End Sub

Sub createJpg(SheetName$, xRgAddrss$, nameFile$)
  Dim xRgPic As Range, xShape As Shape
  ThisWorkbook.Activate: Worksheets(SheetName).Activate
  Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
  xRgPic.CopyPicture
  With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
    .Activate
    For Each xShape In ActiveSheet.Shapes
      xShape.Line.Visible = msoFalse
    Next
    .Chart.Paste: .Chart.Export Environ$("Public") & "\" & nameFile & ".jpg", "JPG"
  End With
  Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
  Set xRgPic = Nothing
End Sub

Function getboiler(fpath$) As String
  Dim fso As Object, ts As Object
  Set fso = CreateObject("scripting.filesystemobject")
  Set ts = fso.getfile(fpath).openastextstream(1, -2)

[/QUOTE]
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
954
Réponses
14
Affichages
3 K
Retour