Macro: Enregistrement PDF non désiré

Le 20/05/2016 à 11:46

Bonjour à tous,

Après avoir utilisé les bons conseils de ce forum depuis quelques temps, et avoir toujours su trouver tout ce dont j'avais besoin, j'ai néanmoins besoin d'un peu d'aide concernant une macro. je précise que je n'ai AUCUNES connaissances en VBA, j'ai recherché sur ce forum, tester, changer, re-tester etc. (la meilleur manière d'apprendre selon moi )

La macro en question est sensée faire les opérations suivantes simultanément:

Envoyer par mail (format PDF) la page active,

Enregistrer dans un dossier spécifié la page active en PDF

Imprimer la page active.

Le macro d'impression de la page active était déjà présente, j'ai rajouter les deux premières que j'ai trouvée sur le forum en les personnalisants

Voici la macro en question:

Sub SendPrintsaveMiddlegate()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim CurFile As String
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
CurFile = ThisWorkbook.Path & "\" & "Middlegate.Pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With olMail
.To = "expedition@exemple.be"
.Subject = "Bon de Chargement"
.Body = "Vous trouverez ci-joint le fichier PDF reprenant le bon de chargement du jour..."
.Attachments.Add CurFile
.Send
End With
Set olMail = Nothing
Set olApp = Nothing
Dim fichier As String
fichier = "X:\Logist\Expédition\Bon de chargement\Middlegate\" & [G1].Value & "_" & Format(Now(), "dd-mm-yyyy")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True
For x = 400 To 1 Step -1
Range("A" & x & ":H" & x).Select
For Each cel In Selection
If Trim(cel.Value) <> "" Then
fin = x
GoTo suite
End If
Next cel
Next x
suite:
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & fin
ActiveWindow.SelectedSheets.Application.Dialogs(xlDialogPrint).Show
Range("A1").Select
End Sub

La macro, bien que bidouillée fonctionne correctement si ce n'est qu'un petit soucis:

- Le fichier pdf s'enregistre (en plus de chemin de destination désiré X:\Logist\Expédition\Bon de chargement\Middlegate\) sur le bureau ainsi que sur le chemin X:\Logist\

Que puis-je changer à cette macro afin d'éviter cela ?

Puis-je inverser l'ordre de la macro en Imprimer-Sauvegarder-Envoyer ?

D'avance merci pour votre aide

Francky

Le 20/05/2016 à 16:06

Je ne sais pas si les UPs sont autorisée, mais je me place

Le 20/05/2016 à 22:24

bonjour

 Sub SendPrintsaveMiddlegate()
    Dim olApp As Outlook.Application
    Dim olMail As MailItem
    Dim CurFile As String
    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)

     '-----------------------------####-------------------------
    ' votre ficher active dont vous imprimer et envoyer se trouve dans le dossier "Logist"
    ' ThisWorkbook.Path donne  le dossier parent >>  "Logist"
    ' Alors :  CurFile = ThisWorkbook.Path & "\" & "Middlegate.Pdf" = Logist & "\" & "Middlegate.Pdf"
    '  >> X:\Logist\Middlegate.Pdf
    CurFile = ThisWorkbook.Path & "\" & "Middlegate.Pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _
    Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    '-----------------------------####-------------------------

      '-----------------------------####-------------------------
    With olMail
    .To = "expedition@exemple.be"
    .Subject = "Bon de Chargement"
    .Body = "Vous trouverez ci-joint le fichier PDF reprenant le bon de chargement du jour..."
    .Attachments.Add CurFile
    .Send
    End With

    ' la aussi
      '-----------------------------####-------------------------

    Set olMail = Nothing
    Set olApp = Nothing
    Dim fichier As String
    fichier = "X:\Logist\Expédition\Bon de chargement\Middlegate\" & [G1].Value & "_" & Format(Now(), "dd-mm-yyyy")
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
    For x = 400 To 1 Step -1
    Range("A" & x & ":H" & x).Select
    For Each cel In Selection
    If Trim(cel.Value) <> "" Then
    fin = x
    GoTo suite
    End If
    Next cel
    Next x
suite:
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & fin
    ActiveWindow.SelectedSheets.Application.Dialogs(xlDialogPrint).Show
    Range("A1").Select
    End Sub
Le 22/05/2016 à 00:32

Bonsoir,

Je ne suis pas sur de comprendre ...

Je dois donc completer la ligne afin de donner le chemin plus précis ?

CurFile = ThisWorkbook.Path & "\" & "Middlegate.Pdf"

en

CurFile = ThisWorkbook.Path & "\" & "expedition" & "\" & "bon de chargement" & "\" & "Middlegate.Pdf"

Merci de votre réponse précedente

Le 22/05/2016 à 13:20

BONJOUR

ca depond de ce que vous voulez envoyez

Le 22/05/2016 à 14:39

Je veux envoyer la page active, l'imprimer et qu'elle s'enregistre seulement sur ce chemin:

x:\logist\expedition\bon de chargement\middlegate

Merci

Le 22/05/2016 à 15:10

SVP

envoyer moi fichier joint comme exemples

Le 22/05/2016 à 16:23

Voici le fichier !

J'aimerai lorsque je clique sur le bouton imprimer, le feuille s'imprime, se sauvegarde dans le dossier spécifier en pdf ainsi qu'elles soit envoyer par mal a la boite mail.

En ce moment, elle s'enregistre en plus sur le bureau et en plus dans un mauvais endroit.

Merci

17exemple.xlsm (251.87 Ko)
Le 22/05/2016 à 17:47

bonjour

Combien de factures vous remplissez à la fois ?

Si plus d une;

Vous les imprimer a à la fois ?

Nombre d’article sur chaque facture ?

En dessus vous avez met : Total: Total de pour chaque facture ou toutes les factures

Y t il un cachet au dessous de chaque facture

…………………………………………………………………………….

Le 22/05/2016 à 18:07

Bonjour,

Je l'imprime comme en l'état et une feuille reprenant tout les lignes présentes.

Il ne s'agit pas de facture mais d'articles présent dans le camion.

Tout ce qui est présent sur la feuille = dans le camion

Donc il n'y en a qu'une a la fois avec un nombre d'article qui varie.

Pour le total, j'ai remarqué l'erreur =SOMME(C88:C570) => =SOMME(C13:C570)

Merci

Cela peut parrait plus clair:

Voici ce que je veux imprimer, enregistrer et envoyer automatiquement

22exemple.pdf (227.33 Ko)
Le 22/05/2016 à 23:07

BONSOIR

une question : vous imprimer une feuille a la fois (veut dire plusieurs pages d exels ) ou une page (veut dire palges de cellules par exemple (A1:H40) ?

ce code est juste un essai pour imprimer , exporter et envoyer par email une seul page 21*27 et pas une feuille exel complete

noter que "Middlegate" est la feuille qu a partir on imprime la page :

With Worksheets("Middlegate")
Sub PrintsavesentMiddlegate()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim CurFile As String
Dim fichier As String
Dim Nb As Integer
Dim zone_impression
Dim fin As Integer
Dim val_apercus As Boolean, nbre_copie As Integer

fichier = "X:\Logist\Expédition\Bon de chargement\Middlegate\" & [G1].Value & "_" & Format(Now(), "dd-mm-yyyy")

With Worksheets("Middlegate")
Nb = .Range("F" & Rows.Count).End(xlUp).Row + 1
nbre_copie = .Range("K" & 9)
val_apercus = .Range("K" & 10)

fin = 39
 zone_impression = "A1:H" & fin

.Range(zone_impression).PrintOut , , nbre_copie, val_apercus ', nom_imprimante, , , ignorer_zone

.Range(zone_impression).ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)

With olMail
 .To = "expedition@techspace-aero.be"
 .Subject = "Bon de Chargement"
 .Body = "Vous trouverez ci-joint le fichier PDF reprennant le bon de chargement du jour..."
 .Attachments.Add fichier
 .Send
End With

Set olMail = Nothing
Set olApp = Nothing
.Range("A1").Select

End With
End Sub
Rechercher des sujets similaires à "macro enregistrement pdf desire"