Discussion :

[Hicks1070]

Bonjour a vous,

je travail sur un VBA que j'ai trouvé car je ne suis pas top en script. Le but de celui-ci est de remplir automatiquement un fichier PDF a partitr d'un fichier Excel.

Fonctionnement:
Lorsque je choisi une ligne du fichier Excel et appui sur le boutton imprimer formulaire DPTI que j'ai crée tous fonctionne, mais le VBA a été fait de facon qu'un fichier FDF est créé automatiquement dans le dossier contenant mon fichier PDF et Excel souce.

Vu que mon fichier sera sur sharepoint, je ne veux pas que le fichier sois créé sur sharepoint car nous ne pouvont pas effacer ceux-ci sauf si j'en fais la demande.

J'aimerais que le fichier FDF sois créé temporairement ou choisir un dossier sur l'ordinateur a la place du fichier source qui est sur sharepoint.

Cela est-il possible?

Merci

[mfoxy]

Bonjour,

Pourriez vous déposer le code plutôt que le fichier ?
Il est 'mal' vu de déposer un fichier dès le premier post, et peu de membre ouvre les fichiers joint pour raison de sécurité.

Certainement un'ThisWorkbook. Path' à modifier par un chemin précis sur votre Pc.

Bav,

[Hicks1070]

D'accord, désolé.

Module 1:

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_NORMAL = 1
Public Const PDF_FILE = "Entente DPTI.pdf"
 
 
Public Sub DPTI_FR()
 
    Dim sFileHeader As String
    Dim sFileFooter As String
    Dim sFileFields As String
    Dim sFileName As String
    Dim sTmp As String
    Dim lngFileNum As Long
    Dim vClient As Variant
 
 
    ' Builds string for contents of FDF file and then writes file to workbook folder.
    On Error GoTo ErrorHandler
 
    sFileHeader = "%FDF-1.2" & vbCrLf & _
                  "%âãÏÓ" & vbCrLf & _
                  "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
                  "endobj" & vbCrLf & _
                  "2 0 obj[" & vbCrLf
 
    sFileFooter = "]" & vbCrLf & _
                  "endobj" & vbCrLf & _
                  "trailer" & vbCrLf & _
                  "<</Root 1 0 R>>" & vbCrLf & _
                  "%%EO"
 
 
    sFileFields = "<</T(Nom)/V(---NAME---)>>" & vbCrLf & _
                  "<</T(Matricule)/V(---Matricule---)>>" & vbCrLf & _
                  "<</T(Model0)/V(---Model0---)>>" & vbCrLf & _
                  "<</T(Type0)/V(---Type0---)>>" & vbCrLf & _
                  "<</T(Size0)/V(---Size0---)>>" & vbCrLf & _
                  "<</T(Serie0)/V(---Serie0---)>>" & vbCrLf & _
                  "<</T(Class0)/V(---Class0---)>>" & vbCrLf & _
                  "<</T(NomSig0)/V(---NomSig0---)>>" & vbCrLf & _
                  "<</T(NomSigOSSI)/V(---NomSigOSSI)>>" & vbCrLf & _
                  "<</T(f1_12(0))/V()>>" & vbCrLf
 
 
 
    vClient = Range(Selection.Row & ":" & Selection.Row)
 
    sFileFields = Replace(sFileFields, "---NAME---", vClient(1, 9))
    sFileFields = Replace(sFileFields, "---Matricule---", vClient(1, 11))
    sFileFields = Replace(sFileFields, "---Model0---", vClient(1, 2))
    sFileFields = Replace(sFileFields, "---Type0---", vClient(1, 4))
    sFileFields = Replace(sFileFields, "---Size0---", vClient(1, 5))
    sFileFields = Replace(sFileFields, "---Serie0---", vClient(1, 6))
    sFileFields = Replace(sFileFields, "---Class0---", vClient(1, 7))
    sFileFields = Replace(sFileFields, "---NomSig0---", vClient(1, 9))
    sFileFields = Replace(sFileFields, "---NomSigOSSI", vClient(1, 12))
 
 
    sTmp = sFileHeader & sFileFields & sFileFooter
 
 
 
    ' Write FDF file to disk
    If Len(vClient(1, 9)) Then sFileName = vClient(1, 9) Else sFileName = "FDF_DEMO"
    sFileName = ActiveWorkbook.Path & "\" & sFileName & ".fdf"
    lngFileNum = FreeFile
    Open sFileName For Output As lngFileNum
    Print #lngFileNum, sTmp
    Close #lngFileNum
    DoEvents
 
    ' Open FDF file as PDF
    ShellExecute vbNull, "open", sFileName, vbNull, vbNull, SW_NORMAL
    Exit Sub
 
ErrorHandler:
    MsgBox "MakeFDF Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source
 
End Sub

[mfoxy]

Bonjour,

Logiquement, je dirai, a modifier ThisWorkbook.path la ligne :

Code :

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

1
2
 
sFileName = ActiveWorkbook.Path & "\" & sFileName & ".fdf"

Par un chemin de dossier destination du genre c:\dossier entre guillemets

Code :

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

1
2
 
sFileName = "lechemindudossierdeDestination" & "\" & sFileName & ".fdf"

[Hicks1070]

Wow merci beaucoup c'etais facile, faut juste y penser.

Je me demandais si cela est possible d'ajouter une ligne VBA pour créé le dossier automatiquement si celui-ci n'existe pas?

[mfoxy]

Hello,

Content que cela t'ai aider.
Pour répondre à ta dernière question, c'est faisable.

Il te faudrait une fonction vérifiant que le dossier de destination existe et si pas le créé.
Une petite recherche sur ce forum devrait te donner des functions de ce type.

Bat