Macro enregistrer en pdf + mail niveau sup

Le 05/01/2018 à 00:21

Bonsoir, j'ai chaque semaine, à traiter un grand tableau.

J'ai réussi à créer une macro qui permet de créer un dossier excel par ligne du tableau. Chaque dossier se crée et s'enregistre en format excel dans un dossier que j'ai choisi : "F:..............".

Je vous mets le code ci-dessous

Sub MacroFactures()

Application.ScreenUpdating = False

'postionnement Cell A1

Range("A2").Select
'on boucle pour determiner le nombre de lignes et on recupere nbligne
nbligne = 2
Do While Not (IsEmpty(ActiveCell))

    Selection.Offset(1, 0).Select

     Range("A" & nbligne & ":AI" & nbligne).Select
    Selection.Copy
    '*****************
    '          ATTENTION                         CHEMIN A MODIFIER
    '*****************

    Workbooks.Open Filename:= _
        "F:\Execution V2\Base de données\Modèle Facture.xlsx"

    Range("E2").Select
    ActiveSheet.Paste
    Range("E2").Select
    Application.CutCopyMode = False
    Selection.Cut Destination:=Range("F14")

    Range("F2").Select
    Selection.Cut Destination:=Range("C14")

    Range("G2").Select
    Selection.Cut Destination:=Range("N6")

    Range("H2").Select
    Range("H2").Cut Destination:=Range("D12")

    Range("I2").Select
    Selection.Cut Destination:=Range("G12")

    Range("J2").Select
    Selection.Cut Destination:=Range("I12")

    Range("K2").Select
    Selection.Cut Destination:=Range("R14")

    Range("L2").Select
    Selection.Cut Destination:=Range("N7")

    Range("M2").Select
    Selection.Cut Destination:=Range("N8")

    Range("N2").Select
    Selection.Cut Destination:=Range("P8")

    Range("O2").Select
    Selection.Cut Destination:=Range("K12")

    Range("P2").Select
    Selection.Cut Destination:=Range("H14")

    Range("Q2").Select
    Selection.Cut Destination:=Range("E12")

    Range("R2").Select
    Selection.Cut Destination:=Range("J14")

    Range("S2").Select
    Selection.Cut Destination:=Range("J15")

    Range("T2").Select
    Selection.Cut Destination:=Range("L15")

    Range("U2").Select
    Selection.Cut Destination:=Range("C21")

    Range("V2").Select
    Selection.Cut Destination:=Range("F21")

    Range("W2").Select
    Selection.Cut Destination:=Range("N19")

    Range("X2").Select
    Selection.Cut Destination:=Range("J19")

    Range("Y2").Select
    Selection.Cut Destination:=Range("L19")

    Range("Z2").Select
    Selection.Cut Destination:=Range("P19")

    Range("AA2").Select
    Selection.Cut Destination:=Range("P43")

    Range("AB2").Select
    Selection.Cut Destination:=Range("F45")

    Range("AC2").Select
    Selection.Cut Destination:=Range("N54")

    Range("AD2").Select
    Selection.Cut Destination:=Range("J54")

    Range("AE2").Select
    Selection.Cut Destination:=Range("R19")

    Range("AF2").Select
    Selection.Cut Destination:=Range("R43")

    Range("AG2").Select
    Selection.Cut Destination:=Range("H45")

    Range("AH2").Select
    Selection.Cut Destination:=Range("R45")

    Range("AI2").Select
    Selection.Cut Destination:=Range("R48")

    Range("AJ2").Select
    Selection.Cut Destination:=Range("R50")

    Range("AK2").Select
    Selection.Cut Destination:=Range("R54")

    Range("AL2").Select
    Selection.Cut Destination:=Range("C12")

    Range("AM2").Select
    Selection.Cut Destination:=Range("N9")

    Range("I2").Select
    Range("H8").Select
    Selection.Cut Destination:=Range("J2")
    Range("J2").Select
    Selection.Copy

    Range("H8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I2:J2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B12").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D15").Select
     toto = Range("C14").Value
    ActiveWindow.SmallScroll Down:=-15
    '*****************
    '         ATTENTION                              CHEMIN A MODIFIER
    'Type:=xlTypePDF, Filename:= _

    '*****************
    ActiveWorkbook.SaveAs Filename:= _
        "F:\Execution V2\Fichiers temporaires\Factures\ " & toto & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWindow.Close
  nbligne = nbligne + 1
  Range("A" & nbligne).Select
    Loop
   ' Range("G10").Value = nbligne
   Application.ScreenUpdating = True

'Déclare la variable objet Worksheet
Dim Ws As Worksheet

'Boucle sur toutes les feuille de calcul du classeur. Les onglets graphiques ne sont pas pris
'en compte.
'ThisWorkbook correspond à l'objet classeur contenant la macro
For Each Ws In ThisWorkbook.Worksheets
    'Renvoie le nom de chaque feuille
    MsgBox Ws.Name
Next Ws

End Sub

Jusque là tout va bien

Il faudrait maintenant que je puisse envoyer chaque dossier crée, par mail, en format pdf.

Le pdf devrait être nommé "Liste" + contenu de la cellule "C14" + contenu de la cellule "H14"

L'adresse mail à laquelle doit être envoyé le pdf est en cellule N10 de chaque feuille excel créee

Il faudrait aussi pouvoir mettre un titre "Liste" + contenu de la cellule "C14", un texte fixe et une signature.

Si quelqu'un voit une solution

Le 05/01/2018 à 04:52

https://forum.excel-pratique.com/viewtopic.php?p=606015#p606015

Rechercher des sujets similaires à "macro enregistrer pdf mail niveau sup"