Discussion :

[nouha_79]

bonjour,

voila j ai pu enfin trouver la solution pour enregistrer mon fichier sous forme de pdf.jusqu a la ca marche parfait.le probleme maintenant que des que je clique sur le button envoyer ,une fenetre sort pour enregistrer d abord le fichier sous excle forme ou bien sous pdf.
qund je choisi sous excel ca marche parfait et il est envoyer mais quand je choisi sous forme PDF il l enregistre et il est envoyer mais qu on veux l ouvrir il est endommager ?

voila mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Btn_99_Druckausgabe_Email_Click()
 
'Date$ liefert MM-TT-YYY. Die Bindestriche müssen raus
 datum = Mid(Date$, 7, 4) & Left(Date$, 2) & Mid(Date$, 4, 2)
 
 
Set Applic = Application.ActiveWorkbook 'Merken der Tool-Application
MSG = Range("M_MAIL_ADR")
 Mailadress = InputBox(MSG, "Email Adress")
 
Dim x
x = InStr(1, Mailadress, "@")
MSG4 = Range("M_MAIL_ERR")
 
If Mailadress = "" Or x = 0 Then
MsgBox (MSG4)
Exit Sub
End If
 
 
test = Mailadress
 '=============================================================================
 
 
    Dim FileSaveName 'Pfad und Dateiname der zu sichernden Datei
    empfaenger = Range("Z_Titelblatt_Kunde")
 
 
      FileSaveName = Application.GetSaveAsFilename _
            (InitialFileName:=pfad & "\Checkliste_" & empfaenger & "_" & datum, _
            FileFilter:="EXCEL-Tabelle (*.xls), *.xls ,pdf datei (*.pdf),*.pdf")
 
      If FileSaveName <> False Then
              Select Case LCase$(Right$(FileSaveName, 3))
            Case "xls"
                ActiveSheet.SaveAs Filename:=FileSaveName
            Case "pdf"
                'deine Druckroutine für PDF
                 ActiveSheet.SaveAs Filename:=FileSaveName, _
                 Password:=""
 
      End Select
      End If
 
    On Error Resume Next 'Fehlerausgang, Weiter mit Löschen, wenn EMail abgelehnt wurde
 
 
    ActiveWorkbook.SendMail Recipients:=Mailadress
 
    MSG1 = Range("M_MAIL1")
    MSG2 = Range("M_MAIL2")
    MSG3 = Range("M_MAIL3")
 
    MsgBox (MSG1 & Chr(13) _
                & "Checkliste_" & empfaenger & "_" & datum & Chr(13) _
                & MSG2 & Chr(13) _
                & Mailadress & Chr(13) _
                & MSG3)
 
End Sub

merci pour votre aide

[nouha_79]

est ce que je peux qutrement faire?
de facon que qu on je clique sur le button envoyer sort la fenetre et je choisi le fichier de mon desktop par exemple et apres je l envoie? estce que c est faisable?

merci