1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
| Private Sub CmdExport_Click()
'Impression selection sheet
'Selection dans listebox
Dim Nom_Feuilles() As Variant, j, n
n = Me.ListSheet.ListCount
j = 0
For i = 0 To n - 1
If Me.ListSheet.Selected(i) = True Then
ReDim Preserve Nom_Feuilles(j)
Nom_Feuilles(j) = Me.ListSheet.List(i)
j = j + 1
End If
Next
If j > 0 Then
Sheets(Nom_Feuilles()).Select
End If
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
NomExcel = ThisWorkbook.Name
NomPDF = Range("J5") & "-" & Left(NomExcel, Len(NomExcel) - 4) & "-" & Format(Date, "dd-mm-yyyy") & ".pdf"
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = ThisWorkbook.Path
.cOption("AutosaveFilename") = NomPDF
' 0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
Dim MailApp As New Outlook.Application
Dim NewMail As MailItem
Dim Dest As String 'Destinataire du mail
Set MailApp = New Outlook.Application
Set NewMail = MailApp.CreateItem(NewMailItem)
With NewMail
' Dest = "adresse1@voila.fr" + ";" + "adresse2@voila.fr" 'Ainsi de suite
' .To = Dest
.Subject = "Sujet du mail"
.Attachments.Add ThisWorkbook.Path & "\" & NomPDF
' "C:\Users\A-youssef\Desktop\commandes\" & Range("D4") & ".pdf"
' .Body = "Blablabla" 'Message
.Importance = olImportanceNormal 'Importance du mail normal
.ReadReceiptRequested = False 'Accusé de lecture
.Display 'Visualise le mail avant envoie (ou Send qui envoie directement le mail sans visualisation) soit l'un soit l'autre jamais les 2
End With
Set selectedSheet = Nothing
Call Me.Hide
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
ListSheet.Clear
For i = 1 To ThisWorkbook.Worksheets.Count
If ThisWorkbook.Worksheets.Item(i).Visible = -1 Then
ListSheet.AddItem (ThisWorkbook.Worksheets.Item(i).Name)
End If
Next i
End Sub |
Partager