none
VBA excel 365 RRS feed

  • Question

  • bonjour,

    Souhaitant utiliser le code VBA suivant, je constate qu'il ne fonctionne pas avec Office 365. D'avance merci et bonne journée.

    Bien cordialement.

    'Envoi Mail format Excel Sub Mail_ActiveSheet() ' Fonctionne avec Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010 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 MonContenu As String 'Contenu du message With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook ActiveSheet.Copy Set Destwb = ActiveWorkbook With Destwb If Val(Application.Version) < 12 Then FileExtStr = ".xls": FileFormatNum = -4143 Else If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "You answered NO in the security dialog." Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With TempFilePath = Environ$("temp") & "\" 'C'est ici pour modifier le nom du fichier qui va s'envoyer par mail TempFileName = Feuil1.Range("D4").Value & " " & " Rotation de stock semaine " & Feuil1.Range("G4").Value Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next With OutMail 'C'est ICI pour modifier les informations concernant le mail .To = "contact-transparences@orange.fr" .CC = "" .BCC = "" .Subject = "Rotation semaine " & Feuil1.Range("G4").Value & " " & Feuil1.Range("D4").Value MonContenu = "Bonjour," & vbNewLine & vbNewLine & _ "Veuillez trouver ci-joint vos rotations à faire pour la semaine" & vbNewLine & vbNewLine & _ "Cordialement" .Body = MonContenu .Attachments.Add Destwb.FullName 'Si tu ne veux pas que Outlook s'ouvre, il faut juste commenter la ligne suivante :) .Display End With On Error GoTo 0 .Close SaveChanges:=False End With Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub

    lundi 29 juillet 2019 09:07

Réponses

Toutes les réponses

  • Bonjour,

    "ne fonctionne pas"... Qu'est-ce qui ne fonctionne pas ? Est-ce qu'il y a une erreur ? Si oui, laquelle ? Sur quelle ligne ?

    Peux-tu poster ton code en utilisant cette icône ?

    Actuellement, tout ton code est en erreur quand on le copie dans la fenêtre de l'éditeur VB.

    Cordialement.

    Daniel

    mardi 30 juillet 2019 08:06
  • Bonsoir Daniel,

    Enfin de compte, la macro fonctionne, au temps pour moi.

    Par contre une demande particulière. Lorsque le code suivant est exécuté :

      

      ActiveWindow.SelectedSheets.Delete

    Excel demande une confirmation de la suppression de l'onglet. Pourriez vous m'indiquer le code qui supprime sans demande de confirmation ?

    Merci.

    Bien cordialement

    mardi 30 juillet 2019 20:47
  • Bonjour,

    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    

    Cordialement.

    Daniel

    • Marqué comme réponse Vincent_Corb mercredi 31 juillet 2019 17:03
    mercredi 31 juillet 2019 09:56
  • Super !

    Merci Daniel.

    Bien cordialement,

    Vincent

    mercredi 31 juillet 2019 13:46