Code VBA ne fonctionne pas

celtar

XLDnaute Junior
Bonjour,

J'ai besoin de votre aide pour finaliser mon fichier sur la feuille 2 j'ai créé un bouton pour générer un fichier PDF celui-ci fonctionne mais je souhaite que cette macro fonctionne également sur ma feuille 1 qui sera le fichier final.

je souhaite également un bouton pour faire un envoi mail a une adresse connu par Outlook sans que celui ci soit ouvert avec un message box a la fin de procédure qui m'indique que le mail est bien parti

Merci pour votre aide.
 

Pièces jointes

  • TEST.xlsm
    37.9 KB · Affichages: 12

Valtrase

XLDnaute Occasionnel
Salut celtar, le fil

J'ai eu besoin de ça personnellement tiens je partage....
VB:
Sub EnvoyerEmail()
' Par Excel-Malin.com ( https://excel-malin.com )
' Adapté par Jean-Paul
' Date      : 06/08/2019


    On Error GoTo EnvoyerEmail_Erreur
    Dim oOutlook As Outlook.Application, WasOutlookOpen As Boolean, oMailItem As Outlook.MailItem
    Dim Body As Variant, Subject As String
    Dim Filename1 As String, LineHeader As String, sFolder As String
    Dim bOpenAfterPublish As Boolean
  
    sFolder = "TonChemin"

    Subject = "Ton sujet"
'Ci-dessous une selectcase pour choisir soit un fichier xlsx soit un PDF
'A adapter selon ton choix
    Select Case "A adapter selon ton choix"
        Case 0  'Save as PDF
'Le nom FileName1 est aussi à adapter selon ton choix     
            Filename1 = sFolder & _
                        Subject & ".pdf"
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
                                               Filename:=Filename1, _
                                               Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                                               IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=bOpenAfterPublish

        Case 1  'Save as Xlsm
            Filename1 = sFolder & _
                        Subject & ".xlsm"
            ActiveWorkbook.SaveCopyAs Filename1

        Case Else

    End Select


    Body = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & _
           "<HTML><HEAD>" & _
           "<META http-equiv=Content-Type content=""text/html; charset=iso-8859-1"">" & _
           "<META content=""MSHTML 6.00.2800.1516"" name=GENERATOR></HEAD>" & _
           "<BODY><DIV STYLE=""font-size: 16px; font-face: Book Antiqua;"">"
  
  
    Body = Body & "Bonjours ci-joint les documents demandés<br>Cordialement, M. XXX"

    'Application_ItemSend

    'Préparer Outlook
    PreparerOutlook oOutlook
    Set oMailItem = oOutlook.CreateItem(0)
    
    'Création de l'email
    With oMailItem
      
        '.From = "Mettre l'expéditeur sinon par défaut"
        .To = "Destinataire@exemple.fr"
        .cc = "Destinataire1@exemple.fr"
        .Subject = Subject
        .BodyFormat = olFormatHTML
        .HTMLBody = Body & "<br><br>" & .HTMLBody               'Signature  Body & "<br><br>" &
        .Attachments.Add Filename1
        If "A adapter a tes besoins pour voir le courriel avant l'envoie" = True Then
            .Display                                            '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
        End If
        '.Save      '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
        '.Send      '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
    End With

EnvoyerEmail_Exit:
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

    Exit Sub

EnvoyerEmail_Erreur:

    MsgBox "Oupss... le mail n'a pas pu être envoyé..." & vbNewLine & Err, vbCritical, "Erreur"
    Resume EnvoyerEmail_Exit
End Sub

Private Sub PreparerOutlook(ByRef oOutlook As Object)
'par Excel-Malin.com ( https://excel-malin.com )
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.

    On Error GoTo PreparerOutlookErreur


    On Error Resume Next
    'vérification si Outlook est ouvert
    Set oOutlook = GetObject(, "Outlook.Application")

    If (Err.Number <> 0) Then                                   'si Outlook n'est pas ouvert, une instance est ouverte
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    Else                                                        'si Outlook est ouvert, l'instance existante est utilisée
        Set oOutlook = GetObject("Outlook.Application")
        oOutlook.visible = True
    End If
    Exit Sub

PreparerOutlookErreur:
    MsgBox "Oups..." & vbNewLine & "Nous n'avons pas pu charger Outlook !"
End Sub

J'ai collé ça à la volée donc pas de contrôle et peut-être des erreurs par ci par là.....
Concernant les fichiers qui ont le même nom, tu dois spécifier le non de la feuille avant ton Range(XXXXX) sinon elle prends la feuille active par défaut.
De plus je te renvoie sur un peu de lecture Ici
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir le fil, bonsoir le forum,

Bien vu Feuil1(Feuil2), Feuil2(Feuil1) ! Pour foutre la m**de y'avait pas mieux...
A1 contient le caractère ":" qui est interdit dans le nom d'un fichier, supprime ce caractère ou modifie le code...

VB:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
chemin & "\Serie " & Range("D4").Value & " .pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
 

Discussions similaires

Réponses
1
Affichages
78
Compte Supprimé 979
C
Réponses
2
Affichages
99

Statistiques des forums

Discussions
311 730
Messages
2 081 989
Membres
101 856
dernier inscrit
Marina40