Bonjour a tous,
J'ai grâce à plusieurs aides développé cette macro, le probleme est qu'elle est trop lourde et je suis sûr que la moitié n'est pas utile. Quelqu'un peut-il m'aider à la simplifier svp (car j'ai certain beug de lancement d'outlook et je me demande si ce n'est pas du au volume de la macro...). Merci

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub test_lien_PDF() 'Devis
With ActiveSheet.PageSetup
    .Orientation = xlLandscape
 
Worksheets("Demande de réparation").ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:="C:\Users\TECH\Desktop\enregistrement PDF.pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
 
        If .Orientation = xlLandscape Then
 
        .Orientation = xlPortrait
        End If
 
        .Orientation = xlLandscape
        End With
 
Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim olFormatHTML As String
    FileAttach = "C:\Users\TECH\Desktop\enregistrement PDF.pdf" _
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
     strbody = "Information sur la mise à jour"
    On Error Resume Next
        With OutMail
            Select Case Sheets("Demande de réparation").Range("C3") ' <= la valeur à tester
   Case Is = "Test"
      .To = "Test@hotmail.fr"
            .Bcc = ""
            .Subject = "Demande de réparation"
            .BodyFormat = olFormatHTML
          .HTMLBody = "Bonjour, <BR><BR>Ce message vous informe que     " & Worksheets("Demande de réparation").Cells(3, "C") & "      a enregistré la pièce      " & Worksheets("Fiche de réparation").Cells(2, "I") & "       dans le fichier réparation materiel .<BR><BR>" _
            & "<A href=" & """" & "\\Nom_serveur\Repertoire\nom_ficihier.xls" & """" & "></A>" & Chr(10) & "<BR><BR>Cordialement"
            .Attachments.Add Réparation_matériel_test2
            .Attachments.Add (FileAttach)
            .OriginatorDeliveryReportRequested = False
            .ReadReceiptRequested = False
            .Display
 
 
        End With
            On Error GoTo 0
 
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub