définir une fonction

[grosquick59]

Bonjour,
je souhaiterai définir une fonction qui me permettrai d'éviter les répétions dans mon code VBA. Je m'explique :
j'ai utilisé un code pour envoyer la feuille excel en pièce jointe avec un message type.
Ce code est répété pour plusieurs secteurs. Une macro par secteur.
Voici mon code :

Sub EnvoiFeuilleAQS()
' Cette macro permet d'envoyer la feuille par mail en pièce jointe à une liste d'utilisateurs par défaut
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
    Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A:N").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "Une des colonnes est manquante ou la feuille est protégée. " & _
               "Déverouillez la feuille ou vérifiez les lignes ou colonnes et ré-essayez.", vbOKOnly
        Exit Sub
    End If

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

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Selection of " & wb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    If Val(Application.Version) < 12 Then
        ' En cas d'utilisation d'Excel 2000 ou 2003.
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        ' En cas d'utilisation d'Excel 2007 ou 2010.
        FileExtStr = ".xls": FileFormatNum = -4143
    End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next

' Les champs subject et Body peuvent être changés aussi, ils contiennent le corps du message et l'objet 'sujet).
    
'Définir un message type puis l'associer à une fonction.
'Par exemple "messagetype" comme ci dessous :

messagetype = "Bonjour, vous trouverez dans ce mail la liste des actions à réaliser suite aux forums MDC (récent + relance des anciennes). Une fois ces actions effectuées merci d'en informer par e-mail :" & vbLf & "robert, gérard, louis." & vbLf & "N'oubliez pas de préciser la date de réalisation" & vbLf & _
            "Pour information un formulaire électronique est disponible sur le réseau à cet emplacement : \inter_services\AQ_  " & vbLf & _
            " Ce formulaire est à utiliser en priorité par rapport à la version papier..." & vbLf & _
            "NB : L'envoie de cet email étant automatisé il se peut que vous n'ayez aucune action à faire. Dans ce cas merci de ne pas tenir compte de cet e-mail. " & vbLf & _
            "Cordialement," & vbLf & _
            "AQ Systèmes"
            
    'cela nous permettra d'indiquer pour chaque secteur body = messagetype au lieu de recopier le texte en entier
 
        With OutMail
            .To = "robert xxx "
            .Cc = ""
            .Bcc = ""
            .Subject = "Suivi des actions MDC"
            .Body = messagetype
            .Attachments.Add Dest.FullName
            .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

J'ai 10 macro identiques. Je souhaiterai avoir le messagetype en contenu.
Quelqu'un peut-il m'aider ?

 

[Pierrot93]

Re : définir une fonction

Bonsoir Grosquick

essaye peut être en utilisant une constante, à déclarer en tête de module :

Option Explicit
Const messagetype As String = "Bonjour, vous trouverez dans ce mail la liste des actions à réaliser suite aux forums MDC (récent + relance des anciennes). Une fois ces actions effectuées merci d'en informer par e-mail :" & vbLf & "robert, gérard, louis." & vbLf & "N'oubliez pas de préciser la date de réalisation" & vbLf & _
            "Pour information un formulaire électronique est disponible sur le réseau à cet emplacement : \inter_services\AQ_  " & vbLf & _
            " Ce formulaire est à utiliser en priorité par rapport à la version papier..." & vbLf & _
            "NB : L'envoie de cet email étant automatisé il se peut que vous n'ayez aucune action à faire. Dans ce cas merci de ne pas tenir compte de cet e-mail. " & vbLf & _
            "Cordialement," & vbLf & "AQ Systèmes"

pour tester, à la suite tu rajoutes :

Sub test()
MsgBox messagetype
End Sub

bonne soirée
@+

 

[grosquick59]

Re : définir une fonction

Merci beaucoup Pierrot. ça marche, c'est super ça va me simplifier la tâche.
Bonne soirée