Microsoft 365 MSG box avec deux options

[Roseline]

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

 

[soan]

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 :

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

 

[Roseline]

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 :

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.

 

[soan]

merci pour ton retour ! à toi aussi, excellente journée !

 

[Roseline]

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 :

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]