Note: The other languages of the website are Google-translated. Back to English

Comment enregistrer une feuille de calcul en tant que fichier PDF et l'envoyer par e-mail en tant que pièce jointe via Outlook?

Dans certains cas, vous devrez peut-être envoyer une feuille de calcul sous forme de fichier PDF via Outlook. Habituellement, vous devez enregistrer manuellement la feuille de calcul en tant que fichier PDF, puis créer un nouvel e-mail avec ce fichier PDF en pièce jointe dans votre Outlook et enfin l'envoyer. Il faut du temps pour y parvenir manuellement étape par étape. Dans cet article, nous allons vous montrer comment enregistrer rapidement une feuille de calcul en tant que fichier PDF et l'envoyer automatiquement en tant que pièce jointe via Outlook dans Excel.

Enregistrez une feuille de calcul en tant que fichier PDF et envoyez-la par courrier électronique en tant que pièce jointe avec le code VBA

Enregistrez une feuille de calcul en tant que fichier PDF et envoyez-la par courrier électronique en tant que pièce jointe avec le code VBA

Vous pouvez exécuter le code VBA ci-dessous pour enregistrer automatiquement la feuille de calcul active en tant que fichier PDF, puis l'envoyer par courrier électronique en tant que pièce jointe via Outlook. Veuillez faire comme suit.

1. Ouvrez la feuille de calcul que vous allez enregistrer au format PDF et envoyer, puis appuyez sur le autre + F11 touches simultanément pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2. dans le Microsoft Visual Basic pour applications fenêtre, cliquez sur insérer > Module. Ensuite, copiez et collez le code VBA ci-dessous dans le Code la fenêtre. Voir la capture d'écran:

Code VBA: enregistrez une feuille de calcul en tant que fichier PDF et envoyez-la par e-mail en tant que pièce jointe

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file 
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email 
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

3. appuie sur le F5 clé pour exécuter le code. dans le DECOUVREZ boîte de dialogue, veuillez sélectionner un dossier pour enregistrer ce fichier PDF, puis cliquez sur le OK .

Notes:

1. La feuille de calcul active est maintenant enregistrée en tant que fichier PDF. Et le fichier PDF est nommé avec le nom de la feuille de calcul.
2. Si la feuille de calcul active est vide, vous obtiendrez une boîte de dialogue comme ci-dessous la capture d'écran affichée après avoir cliqué sur le OK .

4. Un nouvel e-mail Outlook est maintenant créé et vous pouvez voir que le fichier PDF est répertorié en tant que pièce jointe dans le fichier joint. Voir la capture d'écran:

5. Veuillez rédiger cet e-mail puis l'envoyer.
6. Ce code n'est disponible que lorsque vous utilisez Outlook comme programme de messagerie.

Enregistrez facilement une feuille de calcul ou plusieurs feuilles de calcul en tant que fichiers PDF distincts à la fois:

La Classeur fractionné utilité de Kutools for Excel peut vous aider à enregistrer facilement une feuille de calcul ou plusieurs feuilles de calcul en tant que fichiers PDF séparés à la fois, comme le montre la démo ci-dessous. Téléchargez et essayez-le maintenant! (30-journée de parcours gratuit)

Articles connexes:

Les meilleurs outils de productivité de bureau

Kutools for Excel Résout la plupart de vos problèmes et augmente votre productivité de 80 %

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtréeplus
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammesplus
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellulesplus
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDFplus
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2021 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Fonctionnalités complètes Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Commentaires (63)
Noté 5 hors 5 · évaluations 1
Michael
Michael
Ce commentaire a été minimisé par le modérateur sur le site
Cela fonctionne très bien pour moi, mais existe-t-il un moyen de sélectionner automatiquement un emplacement de dossier plutôt que de le sélectionner manuellement ? J'espère faire cela pour 40 feuilles à la fois.
Répondre
0
0
Hugh
Hugh     Michael
Ce commentaire a été minimisé par le modérateur sur le site
En espérant également voir une réponse à ce problème! Merci pour l'aide!
Répondre
0
0
Darren
Darren
Ce commentaire a été minimisé par le modérateur sur le site
J'ai essayé de coller ceci dans un nouveau module et j'obtiens une erreur de compilation : sous ou fonction non définie. S'il vous plaît aider.
Répondre
0
0
cristal
cristal     Darren
Ce commentaire a été minimisé par le modérateur sur le site
Cher Darren,
Quelle version d'Office utilisez-vous ?
Répondre
Rapport
0
0
Nakia
Nakia     cristal
Ce commentaire a été minimisé par le modérateur sur le site
Office 360
Répondre
0
0
Projet de loi
Projet de loi     Darren
Ce commentaire a été minimisé par le modérateur sur le site
Même problème
Répondre
0
0
Michel Charry
Michel Charry
Ce commentaire a été minimisé par le modérateur sur le site
Comment modifier le script VBA ci-dessus afin qu'il ajoute un horodatage au nom du fichier de manière à ne pas écraser ce qui est déjà enregistré?
Répondre
Rapport
0
0
cristal
cristal     Michel Charry
Ce commentaire a été minimisé par le modérateur sur le site
Cher Michael,
Veuillez exécuter le code VBA ci-dessous pour résoudre le problème.

Sous enregistrer au format pdf et envoyer ()
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon en tant qu'entier
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Dim xStr As String

Définir xSht = ActiveSheet
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)

Si xFileDlg.Show = Vrai Alors
xFolder = xFileDlg.SelectedItems(1)
autre
MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"
Exit Sub
Si fin
xStr = Format(Maintenant(), "aaaa-mm-jj-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Vérifier si le fichier existe déjà
Si Len(Dir(xFolder)) > 0 Alors
xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _
vbOuiNon + vbQuestion, "Le fichier existe")
On Error Resume Next
Si xOuiouNon = vbOui Alors
Tuer xFolder
autre
MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"
Exit Sub
Si fin
Si Err.Number <> 0 Alors
MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"
Exit Sub
Si fin
Si fin

Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
'Enregistrer en tant que fichier PDF
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.À = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.Add xFolder
Si DisplayEmail = False Alors
'.Envoyer
Si fin
Terminer par
autre
MsgBox "La feuille de calcul active ne peut pas être vide"
Exit Sub
Si fin
End Sub
Répondre
Rapport
0
0
Parag somani
Parag somani     cristal
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal,

C'est vraiment génial et fonctionne parfaitement pour moi. Besoin d'aide pour ajouter :

1. dans "To", je veux donner un lien vers une cellule particulière de la feuille active comme dans CC et dans BCC, je voudrais ajouter un lien de feuille active
2. dans le corps de l'e-mail, j'ai besoin de spécifier un texte standard.

Je serai grand plein à vous pour votre aide.

Merci
Parag
Répondre
0
0
cristal
cristal     Parag somani
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Parag Somani,
Le code VBA ci-dessous peut vous aider. Veuillez modifier les champs .To, .CC, .BCC et .Body en fonction de vos besoins.

Sous enregistrer au format pdf et envoyer ()
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon en tant qu'entier
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Dim xStr As String

Définir xSht = ActiveSheet
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)

Si xFileDlg.Show = Vrai Alors
xFolder = xFileDlg.SelectedItems(1)
autre
MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"
Exit Sub
Si fin
xStr = Format(Maintenant(), "aaaa-mm-jj-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Vérifier si le fichier existe déjà
Si Len(Dir(xFolder)) > 0 Alors
xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _
vbOuiNon + vbQuestion, "Le fichier existe")
On Error Resume Next
Si xOuiouNon = vbOui Alors
Tuer xFolder
autre
MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"
Exit Sub
Si fin
Si Err.Number <> 0 Alors
MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"
Exit Sub
Si fin
Si fin

Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
'Enregistrer en tant que fichier PDF
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.To = Plage("A8")
.CC = Plage("A9")
.BCC = Plage("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body = "Cher" _
& vbNouvelleLigne & vbNouvelleLigne & _
"Ceci est un e-mail de test" & _
"envoi sous Excel"
.Attachments.Add xFolder
Si DisplayEmail = False Alors
'.Envoyer
Si fin
Terminer par
autre
MsgBox "La feuille de calcul active ne peut pas être vide"
Exit Sub
Si fin
End Sub
Répondre
Rapport
0
0
Mehul
Mehul     cristal
Ce commentaire a été minimisé par le modérateur sur le site
J'ai essayé d'utiliser la plage pour "To", "CC", elle ne récupère tout simplement pas les valeurs de la cellule désignée. Pouvez-vous s'il vous plaît aider à ce sujet?
Merci,
Mehul
Répondre
0
0
Parag somani
Parag somani     cristal
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal,

C'est vraiment génial et fonctionne parfaitement pour moi. Besoin d'aide pour ajouter :

1. dans "To", je veux donner un lien vers une cellule particulière de la feuille active comme dans CC et dans BCC, je voudrais ajouter un lien de feuille active
2. dans le corps de l'e-mail, j'ai besoin de spécifier un texte standard.

Je serai grand plein à vous pour votre aide.

Merci
Parag
Répondre
0
0
Parag
Parag     cristal
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal,

C'est vraiment génial et fonctionne parfaitement pour moi. Besoin d'aide pour ajouter :

1. dans "To", je veux donner un lien vers une cellule particulière de la feuille active comme dans CC et dans BCC, je voudrais ajouter un lien de feuille active
2. dans le corps de l'e-mail, j'ai besoin de spécifier un texte standard.

Je serai grand plein à vous pour votre aide.

Merci
Parag
Répondre
Rapport
0
0
Armin
Armin
Ce commentaire a été minimisé par le modérateur sur le site
Comment puis-je ajouter par exemple la feuille 2 du classeur au format pdf ?
Répondre
0
0
cristal
cristal     Armin
Ce commentaire a été minimisé par le modérateur sur le site
Salut Armin,
Vous devez d'abord ouvrir la feuille 2 dans votre classeur, puis exécuter le code VBA avec les étapes ci-dessus pour l'obtenir.
Répondre
Rapport
0
0
Thomas H
Thomas H
Ce commentaire a été minimisé par le modérateur sur le site
Comment modifier le script VBA ci-dessus afin que le nom du fichier soit enregistré en tant que cellule spécifique sélectionnée dans la feuille actuelle, par exemple la cellule A1 ?
Répondre
0
0
cristal
cristal     Thomas H
Ce commentaire a été minimisé par le modérateur sur le site
Salut Tom.
Désolé, je ne peux pas vous aider.
Bienvenue à poster toute question dans notre forum: https://www.extendoffice.com/forum.html
Vous obtiendrez plus de support Excel de la part des professionnels d'Excel ou d'autres fans d'Excel.
Répondre
Rapport
0
0
Jacques
Jacques
Ce commentaire a été minimisé par le modérateur sur le site
Salut, comment puis-je enregistrer et envoyer le pdf avec le nom du classeur avec le code VBA actuel ? que dois-je utiliser à la place de xSht.Name
Répondre
0
0
cristal
cristal     Jacques
Ce commentaire a été minimisé par le modérateur sur le site
Salut James,
Voulez-vous envoyer la feuille de calcul active au format pdf et la nommer en tant que nom du classeur ?
Répondre
Rapport
0
0
ranga
ranga
Ce commentaire a été minimisé par le modérateur sur le site
Merci ça marche.
Répondre
0
0
Jason
Jason
Ce commentaire a été minimisé par le modérateur sur le site
Comment puis-je lui faire supprimer le pdf enregistré après l'avoir envoyé par e-mail?
Répondre
0
0
cristal
cristal     Jason
Ce commentaire a été minimisé par le modérateur sur le site
Salut Jason,
Désolé, je ne peux pas encore vous aider. Vous devez le supprimer manuellement après l'avoir envoyé par e-mail.
Répondre
Rapport
0
0
Odd-Inge
Odd-Inge
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,

Est-il possible de trouver le nom d'un pdf à partir d'une cellule? Ex. Cellule H4


Et dans la cellule H4, je veux qu'elle soit collectée à partir de trois cellules différentes. Est-ce possible?
Répondre
0
0
Taylor
Taylor     Odd-Inge
Ce commentaire a été minimisé par le modérateur sur le site
C'est possible. Créez des variables séparées pour contenir la valeur des cellules, puis utilisez ces variables lors de la définition de xFolder.
J'ai utilisé la valeur d'une cellule de ma feuille plus la date d'aujourd'hui. Cependant, vous pouvez facilement faire plusieurs valeurs de cellule.

Voilà ce que j'ai ajouté :
Dim xMemberName As String
Estomper xFileDate en tant que chaîne

xNomMembre = Plage("H3").Valeur
xFileDate = Format(Maintenant, "mm-jj")

xDossier = xDossier + "\" xNomMembre + xDateFichier + ".pdf"
Répondre
0
0
Sora
Sora     Taylor
Ce commentaire a été minimisé par le modérateur sur le site
Je reçois une erreur lorsque j'essaie ceci, où dois-je placer cela dans le code ?
Répondre
0
0
Kishore
Kishore
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal,



C'est vraiment génial et fonctionne parfaitement pour moi. Besoin d'aide pour ajouter :

1. dans "Corps", je veux donner un lien vers une cellule particulière de la feuille active. Voudrais en outre mettre le texte en gras.

Merci

Cordialement

Kishore Kumar
Répondre
Rapport
0
0
cristal
cristal     Kishore
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,

Voulez-vous ajouter automatiquement la valeur de la cellule au corps du message et la mettre en gras ? Supposons que vous ajoutiez la valeur de C4 au corps du message. Veuillez appliquer le code ci-dessous.

Sous enregistrer au format pdf et envoyer ()

Dim xSht en tant que feuille de travail

Dim xFileDlg As FileDialog

Estomper xFolder en tant que chaîne

Dim xOuiouNon en tant qu'entier

Dim xOutlookObj en tant qu'objet

Dim xEmailObj en tant qu'objet

Dim xUsedRng As Range



Définir xSht = ActiveSheet

Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)



Si xFileDlg.Show = Vrai Alors

xFolder = xFileDlg.SelectedItems(1)

autre

MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"

Exit Sub

Si fin

xFolder = xFolder + "\" + xSht.Name + ".pdf"



'Vérifier si le fichier existe déjà

Si Len(Dir(xFolder)) > 0 Alors

xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _

vbOuiNon + vbQuestion, "Le fichier existe")

On Error Resume Next

Si xOuiouNon = vbOui Alors

Tuer xFolder

autre

MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _

& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"

Exit Sub

Si fin

Si Err.Number <> 0 Alors

MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _

& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"

Exit Sub

Si fin

Si fin



Définir xUsedRng = xSht.UsedRange

Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors

'Enregistrer en tant que fichier PDF

xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard



'Créer un e-mail Outlook

Set xOutlookObj = CreateObject("Outlook.Application")

Définir xEmailObj = xOutlookObj.CreateItem(0)

Avec xEmailObj

.Afficher

.À = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Attachments.Add xFolder

.HTMLCorps = "
" & Plage("C4") & .HTMLBody

Si DisplayEmail = False Alors

'.Envoyer

Si fin

Terminer par

autre

MsgBox "La feuille de calcul active ne peut pas être vide"

Exit Sub

Si fin

End Sub
Répondre
Rapport
0
0
Geoff
Geoff
Ce commentaire a été minimisé par le modérateur sur le site
Si je voulais qu'il enregistre automatiquement dans un dossier spécifique à chaque fois (éliminant ainsi le besoin pour l'utilisateur de choisir le dossier), comment ferais-je cela ?
Ex. C : Factures/Amérique du Nord/Clients
L'aide est grandement appréciée.
Répondre
0
0
cristal
cristal     Geoff
Ce commentaire a été minimisé par le modérateur sur le site
Salut Geoff,
Voulez-vous dire enregistrer la feuille de calcul en tant que fichier pdf et l'enregistrer dans un dossier spécifique sans l'envoyer ?
Répondre
Rapport
0
0
Jeremy
Jeremy     cristal
Ce commentaire a été minimisé par le modérateur sur le site
Je pense que Geoff signifie pouvoir spécifier un dossier spécifique dans le code dans lequel le pdf est enregistré à chaque fois plutôt que d'avoir à sélectionner l'emplacement manuellement. Le pdf est ensuite envoyé par e-mail à partir de ce dossier spécifique.
Répondre
0
0
cristal
cristal     Jeremy
Ce commentaire a été minimisé par le modérateur sur le site
Merci Jérémie.
Répondre
Rapport
0
0
cristal
cristal     Geoff
Ce commentaire a été minimisé par le modérateur sur le site
Salut Geoff, Si vous souhaitez enregistrer automatiquement le fichier pdf dans un dossier spécifique plutôt que de sélectionner l'emplacement manuellement, veuillez essayer le code ci-dessous. N'oubliez pas de changer le chemin du dossier dans le code.
Sous SaveAsPDFandSend()
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon en tant qu'entier
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Estomper xPath en tant que chaîne
Définir xSht = ActiveSheet
xChemin = "C:\Users\Win10x64Test\Desktop\feuille de calcul en pdf" 'ici "workshet to pdf" est le dossier de destination pour enregistrer les fichiers pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
Si Len(Dir(xFolder)) > 0 Alors
xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _
vbOuiNon + vbQuestion, "Le fichier existe")
On Error Resume Next
Si xOuiouNon = vbOui Alors
Tuer xFolder
autre
MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"
Exit Sub
Si fin
Si Err.Number <> 0 Alors
MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"
Exit Sub
Si fin
Si fin

Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
'Enregistrer en tant que fichier PDF
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.À = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Si DisplayEmail = False Alors
'.Envoyer
Si fin
Terminer par
autre
MsgBox "La feuille de calcul active ne peut pas être vide"
Exit Sub
Si fin
End Sub
Répondre
Rapport
0
0
Alison
Alison
Ce commentaire a été minimisé par le modérateur sur le site
Ce code fonctionne très bien sauf que je veux que la feuille de calcul soit enregistrée en tant que nom de feuille + date (c'est-à-dire Sheet1 le 1er octobre 2020); sur le bureau de l'utilisateur (il sera utilisé par plusieurs personnes et leurs chemins peuvent varier légèrement). Si possible, je souhaite également intégrer un .jpg dans le corps.. le JPG est situé à la fois à l'intérieur de la feuille de calcul (en dehors de la zone d'impression) et l'image est stockée sur un serveur partagé. utilisateur (pour la plupart, c'est un lecteur "T" pour certains un lecteur "U")
cela peut-il être fait? s'il vous plaît et merci un million de fois.
Répondre
0
0
Deepak
Deepak
Ce commentaire a été minimisé par le modérateur sur le site

Salut, ça marche très bien merci pour le partage, juste besoin d'une aide.
Si je veux enregistrer un fichier PDF avec un nom personnalisé (option pour taper le nom du fichier dans la boîte de dialogue Enregistrer sous), en tant qu'utilisateur, utilisez cette option dans le modèle de formulaire où les formulaires sont enregistrés au format PDF avec un nom unique.
Répondre
Rapport
0
0
cristal
cristal     Deepak
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, veuillez essayer le code VBA ci-dessous. Après avoir exécuté le code, sélectionnez un dossier pour enregistrer le fichier PDF, puis une boîte de dialogue apparaîtra pour vous permettre d'entrer le nom du fichier. Sous enregistrer au format pdf et envoyer ()
'Mis à jour par Extendoffice 20210209
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon en tant qu'entier
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Estomper xStrName en tant que chaîne
Dim xV comme variante

Définir xSht = ActiveSheet
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)

Si xFileDlg.Show = Vrai Alors
xFolder = xFileDlg.SelectedItems(1)
autre
MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"
Exit Sub
Si fin
xStrName = ""
xV = Application.InputBox("Veuillez saisir le nom du fichier :", "Kutools for Excel", , , , , , 2)
Si xV = Faux Alors
Exit Sub
Si fin
xStrNom = xV
Si xStrName = "" Alors
MsgBox ("Aucun nom de fichier entré, processus de sortie!")
Exit Sub
Si fin

xDossier = xDossier + "\" + xStrName + ".pdf"
'Vérifier si le fichier existe déjà
Si Len(Dir(xFolder)) > 0 Alors
xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _
vbOuiNon + vbQuestion, "Le fichier existe")
On Error Resume Next
Si xOuiouNon = vbOui Alors
Tuer xFolder
autre
MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"
Exit Sub
Si fin
Si Err.Number <> 0 Alors
MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"
Exit Sub
Si fin
Si fin

Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
'Enregistrer en tant que fichier PDF
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.À = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Si DisplayEmail = False Alors
'.Envoyer
Si fin
Terminer par
autre
MsgBox "La feuille de calcul active ne peut pas être vide"
Exit Sub
Si fin
End Sub
Répondre
Rapport
0
0
mleczus94
mleczus94
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,
Si j'ai deux feuilles dans le fichier et que je souhaite exécuter cette macro sur une feuille (en appuyant sur le bouton) mais en envoyer une autre, comment puis-je l'obtenir ?
Répondre
Rapport
0
0
hein
hein
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, je voudrais enregistrer ceci dans un certain emplacement de fichier, avec le nom basé sur la valeur de la cellule C30.J'ai essayé quelques options, mais je reçois toujours des défauts.
Répondre
0
0
cristal
cristal     hein
Ce commentaire a été minimisé par le modérateur sur le site
Salut hein, Le code ci-dessous peut peut-être aider. Après avoir exécuté le code, sélectionnez un certain dossier pour enregistrer le fichier PDF, puis une boîte de dialogue apparaîtra pour vous permettre d'entrer le nom du fichier. Sous enregistrer au format pdf et envoyer ()
'Mis à jour par Extendoffice 20210209
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon en tant qu'entier
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Estomper xStrName en tant que chaîne
Dim xV comme variante

Définir xSht = ActiveSheet
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)

Si xFileDlg.Show = Vrai Alors
xFolder = xFileDlg.SelectedItems(1)
autre
MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"
Exit Sub
Si fin
xStrName = ""
xV = Application.InputBox("Veuillez saisir le nom du fichier :", "Kutools for Excel", , , , , , 2)
Si xV = Faux Alors
Exit Sub
Si fin
xStrNom = xV
Si xStrName = "" Alors
MsgBox ("Aucun nom de fichier entré, processus de sortie!")
Exit Sub
Si fin

xDossier = xDossier + "\" + xStrName + ".pdf"
'Vérifier si le fichier existe déjà
Si Len(Dir(xFolder)) > 0 Alors
xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _
vbOuiNon + vbQuestion, "Le fichier existe")
On Error Resume Next
Si xOuiouNon = vbOui Alors
Tuer xFolder
autre
MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"
Exit Sub
Si fin
Si Err.Number <> 0 Alors
MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"
Exit Sub
Si fin
Si fin

Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
'Enregistrer en tant que fichier PDF
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.À = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Si DisplayEmail = False Alors
'.Envoyer
Si fin
Terminer par
autre
MsgBox "La feuille de calcul active ne peut pas être vide"
Exit Sub
Si fin
End Sub
Répondre
Rapport
0
0
Hein
Hein     cristal
Ce commentaire a été minimisé par le modérateur sur le site
Merci pour cela, c'est super, mais je veux que la feuille soit nommée selon la cellule A1 sur la feuille 1. l'endroit pour enregistrer selon A1 sur la feuille 2 par exemple C:\Users\peete\Dropbox\Screenshots, et envoyer un e-mail à adresse e-mail sur la feuille A3 2 ce que j'ai déjà travaillé.
Répondre
0
0
HeinPeeters
HeinPeeters     cristal
Ce commentaire a été minimisé par le modérateur sur le site
Merci pour cela, c'est super, mais je veux que la feuille soit nommée selon la cellule A1 sur la feuille 1. l'endroit pour enregistrer selon A1 sur la feuille 2 par exemple C:\Users\peete\Dropbox\Screenshots, mais peut changer quand en utilisant le fichier, et envoyer par e-mail à l'adresse e-mail sur la feuille A3 2 ce que j'ai déjà élaboré.
Répondre
Rapport
0
0
BenSpo
BenSpo
Ce commentaire a été minimisé par le modérateur sur le site
Hi cristal , excellent code merci pour le partage. Existe-t-il un moyen de sélectionner plusieurs feuilles (du même classeur) pour enregistrer chacune en tant que PDF indépendant, puis de les envoyer toutes en pièces jointes dans un seul e-mail ?
Répondre
Rapport
0
0
cristal
cristal     BenSpo
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, le code VBA ci-dessous peut vous rendre service, veuillez essayer. Dans la douzième ligne du code, veuillez remplacer les noms de feuille par les noms de feuille réels dans votre cas.
Sous Saveaspdfandsend1()
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon, I, xNum As Integer
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Dim xArrShetts comme variante
Dim xPDFNameAddress As String
Dim xStr As String
xTabShetts = Tableau("tester", "Feuille1", "Feuille2") 'Entrez les noms des feuilles que vous enverrez sous forme de fichiers pdf entre guillemets et séparez-les par une virgule. Assurez-vous qu'il n'y a pas de caractères spéciaux tels que \/:"*<>| dans le nom du fichier.

Pour I = 0 Vers UBound(xArrShetts)
On Error Resume Next
Définir xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Si xSht.Nom <> xArrShetts(I) Alors
MsgBox "Feuille de calcul introuvable, opération de sortie :" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
Si fin
Suivant


Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
Si xFileDlg.Show = Vrai Alors
xFolder = xFileDlg.SelectedItems(1)
autre
MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"
Exit Sub
Si fin
'Vérifier si le fichier existe déjà
xYesorNo = MsgBox("Si des fichiers de même nom existent dans le dossier de destination, un suffixe numérique sera automatiquement ajouté au nom du fichier pour distinguer les doublons" & vbCrLf & vbCrLf & "Cliquez sur Oui pour continuer, cliquez sur Non pour annuler", _
vbOuiNon + vbQuestion, "Le fichier existe")
Si xOuiouNon <> vbOui Alors Quitter Sub
Pour I = 0 Vers UBound(xArrShetts)
Définir xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Tant que non (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xStr, Qualité :=xlQualityStandard
autre

Si fin
xArrShetts(I) = xStr
Suivant

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.À = ""
.CC = ""
.Sujet = "????"
Pour I = 0 Vers UBound(xArrShetts)
.Pièces jointes.Ajouter xArrShetts(I)
Suivant
Si DisplayEmail = False Alors
'.Envoyer
Si fin
Terminer par
End Sub
Répondre
Rapport
0
0
Bernée Rudolph
Bernée Rudolph     cristal
Ce commentaire a été minimisé par le modérateur sur le site
Salut, Le seul changement avec lequel je me bats est de créer un e-mail séparé pour chaque document pdf créé.
Répondre
0
0
cristal
cristal     Bernée Rudolph
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, pour créer un e-mail séparé pour chaque document pdf, vous pouvez exécuter manuellement le VBA fourni dans le message dans différentes feuilles de calcul pour le faire.
Répondre
Rapport
0
0
Bernée Rudolph
Bernée Rudolph     cristal
Ce commentaire a été minimisé par le modérateur sur le site
J'ai plus de 100 feuilles de calcul dans le classeur, ce qui implique que je dois exécuter le VBA plus de 100 fois, ce qui prend du temps.  
J'ai réussi à diviser mon classeur en plusieurs feuilles, puis je peux convertir chaque feuille de calcul en un document PDF individuel.
La solution que je recherche consiste à envoyer par courrier électronique chaque document PDF séparément pendant que le processus ci-dessus est en cours d'exécution.
Ci-joint le VBA que j'utilise actuellement:
Sous Saveaspdfandsend1()
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon, I, xNum As Integer
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Dim xArrShetts comme variante
Dim xPDFNameAddress As String
Dim xStr As String
xArrShetts = Tableau("02302257", "02400438", "02401829", "02403995", "02408001", "02409208", _
"02409980", "02411881", "02424178", "02430454", "02444046", "02448950", "02450600", _
"02459861", "02461750", "02467535", "02480484", "02484749", "02502041", "02504807", _
"02511843", "02515193", "02523098", "02523244", "02524036", "02524548", "02525516", "02525703", "02525898", "02528908", "02528950", _
"02530381", "02531018", "02531252", "02531277", "02532571", "02533053", "02533474", _
"02534176", "02534592", "02534626", "02535343", "02536386", "02536921", "02537544", _
"02537607", "02538015", "02538755", "02538836", "02538910", "02539685", "02540063", "02540139", "02540158", "02541607", "02542344", _
"02543763", "02543985", "02544116", "02544748", "02544762", "02545026", "02545048", _
"02545080", "02545447", "02545730", "02545814", "02546477", "02547458", "02547673", _
"02547833", "02547912", "02547950", "02547991", "02548848", "02549103", "02549116", "02549125", "02549132", "02549140", "02549182", _
"02549462", "02549499", "02549565", "02549687", "02550049", "02550437", "02550812", _
"02550982", "02551004", "02551005", "02551045", "02552099", "02552222", "02552561", _
"02552684", "02552815", "02552892", "02553031", "02553186", "02553628", "02553721", "02555186", "02556934", "02557137", "02557393", _
"02559121", "02559392", "02559419", "02559512", "02559802", "02559868", "02560052", _
"02560612", "02560684", "02560920", "02561018", "02561061", "02561092", "02561227", _
"02561349", "02561592", "02561630", "02561673", "02561880", "02562359", "02562920", "02562934", "02563013", "02563119", "02563133", _
"02563445", "02563737", "02563828", "02563852", "02563861", "02563971", "02564042", _
"02564315", "02564366", "02564832", "02564909", "02565059", "02565205") 'Entrez les noms des feuilles que vous enverrez sous forme de fichiers pdf entre guillemets et séparez-les par une virgule. Assurez-vous qu'il n'y a pas de caractères spéciaux tels que \/:"*<>| dans le nom du fichier.

Pour I = 0 Vers UBound(xArrShetts)
On Error Resume Next
Définir xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Si xSht.Nom <> xArrShetts(I) Alors
MsgBox "Feuille de calcul introuvable, opération de sortie :" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
Si fin
Suivant


Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)
Si xFileDlg.Show = Vrai Alors
xFolder = xFileDlg.SelectedItems(1)
autre
MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"
Exit Sub
Si fin
'Vérifier si le fichier existe déjà
xYesorNo = MsgBox("Si des fichiers de même nom existent dans le dossier de destination, un suffixe numérique sera automatiquement ajouté au nom du fichier pour distinguer les doublons" & vbCrLf & vbCrLf & "Cliquez sur Oui pour continuer, cliquez sur Non pour annuler", _
vbOuiNon + vbQuestion, "Le fichier existe")
Si xOuiouNon <> vbOui Alors Quitter Sub
Pour I = 0 Vers UBound(xArrShetts)
Définir xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Tant que non (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xStr, Qualité :=xlQualityStandard
autre

Si fin
xArrShetts(I) = xStr
Suivant

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Sujet = "????"
Pour I = 0 Vers UBound(xArrShetts)
On Error Resume Next
.Pièces jointes.Ajouter xArrShetts(I)
Suivant
Si DisplayEmail = False Alors
.Envoyer
Exit Sub
Si fin
Terminer par


End Sub
Répondre
0
0
Tori
Tori
Ce commentaire a été minimisé par le modérateur sur le site
Salut @cristal
C'est fabuleux - l'élément clé avec lequel je me bats est le nom de fichier - j'aimerais que le nom de fichier soit extrait d'une cellule de la feuille de calcul plutôt que d'utiliser le nom de l'onglet. J'ai déjà modifié le code pour l'enregistrer automatiquement dans un dossier spécifié, mais j'ai du mal avec le nom du fichier.
Une aide que vous pouvez offrir s'il vous plaît?
Répondre
0
0
cristal
cristal     Tori
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Tori, si vous souhaitez nommer le fichier PDF avec une valeur de cellule spécifique, veuillez essayer le code suivant. Après avoir exécuté le code et sélectionné un dossier pour enregistrer le fichier, une autre boîte de dialogue apparaît, veuillez sélectionner la cellule que vous utiliserez la valeur comme nom du fichier PDF, puis cliquez sur OK pour terminer.
Sous Saveaspdfandsend2()
'Mis à jour par Extendoffice 20210521
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon en tant qu'entier
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng, xRgInser As Range
Dim xB comme booléen
Définir xSht = ActiveSheet
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)

Si xFileDlg.Show = Vrai Alors
xFolder = xFileDlg.SelectedItems(1)
autre
MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"
Exit Sub
Si fin
xB = Vrai
On Error Resume Next
Alors que xB
Définir xRgInser = Rien
Set xRgInser = Application.InputBox("Sélectionnez une cellule dont vous utiliserez la valeur pour nommer le fichier PDF :", "Kutools for Excel", , , , , , 8)
Si xRgInser n'est rien alors
MsgBox " Aucune cellule sélectionnée, quitter l'opération !", vbInformation, "Kutools for Excel"
Exit Sub
Si fin
Si xRgInser.Text = "" Alors
MsgBox " La cellule sélectionnée est vide, veuillez resélectionner !", vbInformation, "Kutools for Excel"
autre
xB = faux
Si fin
Wend

xFolder = xFolder + "\" + xRgInser.Text + ".pdf"

'Vérifier si le fichier existe déjà
Si Len(Dir(xFolder)) > 0 Alors
xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _
vbOuiNon + vbQuestion, "Le fichier existe")
On Error Resume Next
Si xOuiouNon = vbOui Alors
Tuer xFolder
autre
MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"
Exit Sub
Si fin
Si Err.Number <> 0 Alors
MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"
Exit Sub
Si fin
Si fin

Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
'Enregistrer en tant que fichier PDF
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.À = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Si DisplayEmail = False Alors
'.Envoyer
Si fin
Terminer par
autre
MsgBox "La feuille de calcul active ne peut pas être vide"
Exit Sub
Si fin
End Sub
Répondre
Rapport
0
0
Makeeuropeanu
Makeeuropeanu
Ce commentaire a été minimisé par le modérateur sur le site
Salut, j'avais besoin de quelque chose de similaire, alors voici ce que j'ai. Il prend la date actuelle et crée un nouveau dossier avec le nom de la date dans un emplacement spécifique. Il place le pdf à l'intérieur de ce nouvel emplacement, puis attache le pdf dans un nouvel e-mail. Fonctionne comme un régal. Je ne suis qu'un débutant alors veuillez m'excuser si cela ressemble à un gâchis. :RÉ
Sous PDFTOEMAIL()
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon en tant qu'entier
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Estomper xPath en tant que chaîne
Dim xOutMsg As String
Dim sFolderName As String, sFolder As String
Estomper sFolderPath en tant que chaîne

Définir xSht = ActiveSheet
xFileDate = Format(Maintenant, "jj-mm-aaaa")
sFolder = "C:" 'c'est ici que vous avez un dossier principal
sFolderName = "Week ending " + Format(Now, "dd-mm-yyyy") 'dossier à créer dans le dossier principal avec le nom Week end et la date actuelle
sFolderPath = "C:" & sFolderName 'dossier principal pour créer le nouveau chemin, y compris le nouveau dossier
Set oFSO = CreateObject("Scripting.FileSystemObject")
Si oFSO.FolderExists(sFolderPath) Alors
MsgBox "Le dossier existe déjà !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
autre
MkDir sFolderPath
MsgBox "Un nouveau dossier a été créé !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Si fin
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Si Len(Dir(xFolder)) > 0 Alors
xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _
vbOuiNon + vbQuestion, "Le fichier existe")
On Error Resume Next
Si xOuiouNon = vbOui Alors
Tuer xFolder
autre
MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"
Exit Sub
Si fin
Si Err.Number <> 0 Alors
MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"
Exit Sub
Si fin
Si fin

Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Veuillez trouver ci-joint Cet e-mail et cette pièce jointe ont été générés automatiquement "
'ajoute une note indiquant que l'e-mail a été généré automatiquement

Avec xEmailObj
.Afficher
.To = "" 'ajoutez vos propres e-mails
.CC = ""
.Subject = xSht.Name + " PDF pour la semaine se terminant " + xFileDate + " - Location " ' le sujet inclut le nom de la feuille, le pdf, la date et l'emplacement, cela peut être modifié si nécessaire
.Attachments.Add xFolder
.HTMLBody = xOutMsg & .HTMLBody
Si DisplayEmail = False Alors
'.Envoyer <--- Ici, si vous supprimez l'apostrophe, l'e-mail sera envoyé automatiquement, alors soyez prudent
Si fin
Terminer par
autre
MsgBox "La feuille de calcul active ne peut pas être vide"
Exit Sub
Si fin
End Sub
Répondre
Rapport
0
0
Nicole
Nicole
Ce commentaire a été minimisé par le modérateur sur le site
Comment puis-je modifier ce code pour enregistrer uniquement les cellules ("a1:r99") à enregistrer au format PDF. J'ai des éléments supplémentaires sur les côtés que je ne veux pas dans mon document PDF.
Sous enregistrer au format pdf et envoyer ()
'Mis à jour par Extendoffice 20210209
Dim xSht en tant que feuille de travail
Dim xFileDlg As FileDialog
Estomper xFolder en tant que chaîne
Dim xOuiouNon en tant qu'entier
Dim xOutlookObj en tant qu'objet
Dim xEmailObj en tant qu'objet
Dim xUsedRng As Range
Estomper xStrName en tant que chaîne
Dim xV comme variante

Définir xSht = ActiveSheet
Définir xFileDlg = Application. FileDialog (msoFileDialogFolderPicker)

Si xFileDlg.Show = Vrai Alors
xFolder = xFileDlg.SelectedItems(1)
autre
MsgBox "Vous devez spécifier un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Doit spécifier le dossier de destination"
Exit Sub
Si fin
xStrName = ""
xV = Application.InputBox("Veuillez saisir le nom du fichier :", "Kutools for Excel", , , , , , 2)
Si xV = Faux Alors
Exit Sub
Si fin
xStrNom = xV
Si xStrName = "" Alors
MsgBox ("Aucun nom de fichier entré, processus de sortie!")
Exit Sub
Si fin

xDossier = xDossier + "\" + xStrName + ".pdf"
'Vérifier si le fichier existe déjà
Si Len(Dir(xFolder)) > 0 Alors
xYesorNo = MsgBox(xFolder & " existe déjà." & vbCrLf & vbCrLf & "Voulez-vous l'écraser ?", _
vbOuiNon + vbQuestion, "Le fichier existe")
On Error Resume Next
Si xOuiouNon = vbOui Alors
Tuer xFolder
autre
MsgBox "si vous n'écrasez pas le PDF existant, je ne peux pas continuer." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Quitter la macro"
Exit Sub
Si fin
Si Err.Number <> 0 Alors
MsgBox "Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n'est pas ouvert ou protégé en écriture." _
& vbCrLf & vbCrLf & "Appuyez sur OK pour quitter cette macro.", vbCritical, "Impossible de supprimer le fichier"
Exit Sub
Si fin
Si fin

Définir xUsedRng = xSht.UsedRange
Si Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Alors
'Enregistrer en tant que fichier PDF
xSht.ExportAsFixedFormat Type :=xlTypePDF, Nom de fichier :=xFolder, Qualité :=xlQualityStandard

'Créer un e-mail Outlook
Set xOutlookObj = CreateObject("Outlook.Application")
Définir xEmailObj = xOutlookObj.CreateItem(0)
Avec xEmailObj
.Afficher
.À = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Si DisplayEmail = False Alors
'.Envoyer
Si fin
Terminer par
autre
MsgBox "La feuille de calcul active ne peut pas être vide"
Exit Sub
Si fin
End Sub
Répondre
0
0
RLF
RLF     Nicole
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, je viens d'essayer ce code sur l'une de mes feuilles de calcul et j'ai défini des zones d'impression pour que les éléments supplémentaires en bas n'apparaissent pas dans le pdf. Essayez-le !
Répondre
0
0
Rod Bennett
Rod Bennett
Ce commentaire a été minimisé par le modérateur sur le site
Hi
Merci beaucoup pour le code, mais est-il possible d'enregistrer automatiquement le PDF au même emplacement que le fichier Excel actif et avec le même nom de fichier que le fichier Excel actif ?
Merci beaucoup.
Barre
Répondre
0
0
Il n'y a pas encore de commentaires postés ici
Télécharger d'autres activités

Nous suivre

Copyright © 2009 - www.extendoffice.com. | Tous les droits sont réservés. Alimenté par ExtendOffice. | | Plan du site
Microsoft et le logo Office sont des marques commerciales ou des marques déposées de Microsoft Corporation aux États-Unis et / ou dans d'autres pays.
Protégé par Sectigo SSL