Problème pour convertir en PDF

kiki29 à dit:

Salut, mais visiblement tout le monde ne l'avait pas compris, même toi

Cliquez pour agrandir...

kiki29 à dit:

Par contre Il semblerait que tu puisses paramétrer CutePDF si l'on en croit leur site, perso je me refuse à installer un 3eme outil de conversion en PDF pour le tester.

Cliquez pour agrandir...

ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,""CutePDF Writer sur CPW2:"",,TRUE,,FALSE)"

ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= "CutePDF Writer on CPW2:", Collate:=True

[A1:G50].PrintOut Copies:=1, preview:=False, ActivePrinter:="CutePDF Writer sur CPW2:", _
printtofile:=True, Collate:=True, prtofilename:="P:\PDF\tesft" & FundName & ".pdf"

' Impression en PDF
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=   "CutePDF Writer on CPW2:", Collate:=True
   
' Pause de 2 secondes
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
   Application.Wait waitTime

' Saisie auto du nom de fichier et clic sur entrée
Filename = ActiveSheet.Range("A1").Value & ".pdf"
   SendKeys Filename & "{ENTER}", False

[A1:G50].PrintOut Copies:=1, preview:=False, ActivePrinter:="CutePDF Writer sur CPW2:", _
printtofile:=True, Collate:=True, prtofilename:="P:\PDF\tesft" & FundName & ".pdf"

Cliquez pour agrandir...

Sub PDF_EnvoiEmail()

'Déclaration des variables
Dim ApplicOutlook As Object
Dim ElémentCourrier As Object
Dim cellule As Range
Dim Sujet As String
Dim Email As String
Dim Destinataire As String
Dim mois As String
Dim Msg As String
Dim ZONE As Range


' Vérifie de quelle page la macro est lancée (mon classeur contient 2 pages. Selon celle-ci, des variables sont différentes)

If ActiveSheet.Name = "Sécurité" Then
NOMfichierPDF = Replace(ActiveWorkbook.Name, ".xlsm", "") & " Sécurité - Eq" & [D8] & " - " & Format(Date, "mmmm yyyy")
Msg = "1/4 heure Sécurité de l'UP7/8 - équipe " & [D8] & " du mois de " & Format(Date, "mmmm") & vbCrLf & vbCrLf
Sujet = "1/4 heure Sécurité Exploit UP7/8 - Eq" & [D8]
Set ZONE = [B2:F38]
Else
NOMfichierPDF = Replace(ActiveWorkbook.Name, ".xlsm", "") & " Environnement - Eq" & [D8] & " - " & Format(Date, "mmmm yyyy")
Msg = "1/4 heure Environnement de l'UP7/8 - équipe " & [D8] & " du mois de " & Format(Date, "mmmm") & vbCrLf & vbCrLf
Sujet = "1/4 heure Environnement Exploit UP7/8 - Eq" & [D8]
Set ZONE = [B3:O56]
End If


' Enregistre en pdf (passe par une impression)
[Q15] = "PATIENTER..."
MsgBox ("Un fichier pdf va être enregistrer dans votre dossier sous P:\" & Chr(13) & "Ne rien faire jusqu'à l'apparition du mail, la macro se charge de tout !")

' Impression en PDF
Application.ActivePrinter = "CutePDF Writer sur CPW2:"

[ZONE].PrintOut Copies:=1, ActivePrinter:="CutePDF Writer sur CPW2:", Collate:=True

' Pause de 2 secondes
Application.Wait Now + TimeValue("00:00:03")

' Saisie auto du nom de fichier et clic sur entrée
Filename = "P:" & "\" & NOMfichierPDF

SendKeys Filename '& "{ENTER}", False
Application.Wait Now + TimeValue("00:00:01")
SendKeys "{ENTER}", False
[Q15] = ""

' Création du mail
'Création de l'objet Outlook
Set ApplicOutlook = CreateObject("Outlook.Application")

'Recherche des déstinataires
For Each cellule In _
Columns("Q").Cells.SpecialCells(xlCellTypeConstants)
If cellule.Value Like "*@*" Then

'Extraction des données
Destinataire = cellule.Offset(0, -1).Value
Email = cellule.Value
mois = Format(cellule.Offset(0, 1).Value)

' Piève jointe (fichier PDF
'NOMfichierPDF = Replace(ActiveWorkbook.Name, ".xlsm", "") & " - Eq" & [D8] & " - " & Format(Date, "mmmm yyyy")
Filename = "P:" & "\" & NOMfichierPDF & ".pdf"

'Création du message et envoi
Set ElémentCourrier = ApplicOutlook.CreateItem(0)

With ElémentCourrier
.Attachments.Add Filename
.To = Email
.Subject = Sujet
.Body = Msg
.Display

'Pour envoyer le courrier en automatique,
'activer le .Send ci-dessous
'.Send

End With
End If
Next

End Sub

Cliquez pour agrandir...