Merci !!!
Version imprimable
Merci !!!
Bonjour,
dans le TUTO, je ne trouve pas les fonctions utilisées dans fgAttach()
- FichierExiste()
- fIndiqueFichier()
- fFichierext()
- fVersionProduit()
et la déclaration et l'assignation de eChemin
Ais-je raté quelque chose dans le TUTO ?
Bonjour et merci,
Il s'agit de fonctions complémentaires qui n'ont rien à voir avec le sujet traité.
Les voici :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14 Public Function FichierExiste(cheminNomFichier As String) As Boolean ' Teste l'existence du fichier passé en paramètre. On Error GoTo Errsub Dim oFSO As Scripting.FileSystemObject Set oFSO = New Scripting.FileSystemObject FichierExiste = oFSO.FileExists(cheminNomFichier) Exit Function Errsub: 'traitement à faire End Function
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 Public Function fIndiqueFichier(strCheminFichier As String, strMsg As String) As String ' Ouvre la fenetre Fichier et sélectionne le fichier passé en paramètre ' retourne le chemin et le fichier On Error GoTo Errsub Dim listFile() As Variant If fOuvreFichier(strCheminFichier, msoFileDialogFilePicker, True, listFile, strMsg) Then fIndiqueFichier = listFile(0) End If Exit Function Errsub: 'traitement à faire End Function
Code:
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115 Enum efFichierExt Unite = 8 Chemin = 16 Fichier = 32 'fichier = 3 Extension = 64 [_UNC] = 128 End Enum Enum eTypeAffichage SW_HIDE = 0 SW_SHOWNORMAL = 1 SW_SHOWMINIMIZED = 2 SW_SHOWMAXIMIZED = 3 SW_SHOWNOACTIVATE = 4 SW_SHOW = 5 SW_MINIMIZE = 6 SW_SHOWMINNOACTIVE = 7 SW_SW_SHOWNA = 8 SW_RESTORE = 9 SW_SHOWDEFAULT = 10 SW_FORCEMINIMIZE = 11 End Enum Public Declare Function ShellExecuteA Lib "shell32" (ByVal hwnd As Long, ByVal LPFile As String, ByVal PathFile As String, ByVal Other As String, ByVal Other2 As String, ByVal Param As Long) As Long Public Function fFichierExt(strCheminFichier As String, iType As efFichierExt) As String '--------------------------------------------------------------------------------------- ' Procedure : fFichierExt ' Author : Fabrice CONSTANS (MVP) ' Date : 13/03/2013 ' Purpose : Retourne l'un des éléments suivant le chemin/fichier passé en référence ' ' Parametres: ' strCheminFichier contient le chemin et fichier ' strType = enum eTypeFichierExt ' 64 renvoi l'extension du fichier sans le point ' 32 renvoi le nom du fichier sans son extension ' 16 renvoi le chemin sans le nom ni l'extension ' 8 renvoi l'unité ' Cachée ' 128 renvoi le chemin UNC '--------------------------------------------------------------------------------------- On Error GoTo Errsub Dim vRetour As String If iType And Unite Then ' l'unité vRetour = Left(strCheminFichier, InStr(strCheminFichier, ":")) End If If iType And Chemin Then ' le chemin vRetour = vRetour & Mid(strCheminFichier, 3, InStrRev(strCheminFichier, "\") - 2) End If If iType And Fichier Then Dim tmpFic As String If strCheminFichier Like "*.*" Then tmpFic = Right(strCheminFichier, Len(strCheminFichier) - InStrRev(strCheminFichier, "\")) vRetour = vRetour & Left(tmpFic, InStrRev(tmpFic, ".") - 1) Else vRetour = strCheminFichier End If End If If iType And Extension Then ' renvoi l'extension If iType And Fichier Then vRetour = vRetour & "." vRetour = vRetour & Right(strCheminFichier, Len(strCheminFichier) - InStrRev(strCheminFichier, ".")) End If fFichierExt = vRetour Exit Function Errsub: 'traitement a faire End Function Public Function fOuvreFichier(msoPathFileName As String, msoType As MsoFileDialogType, _ msoMultiSel As Boolean, ByRef tblresult() As Variant, _ Optional strtitre As String = "Sélectionner un fichier") As Boolean ' Ouvre la fenêtre Ouvrefichier/répertoire On Error GoTo Errsub Dim fdg As FileDialog Dim vrtSelectedItem As Variant Dim i As Integer 'Cree un filedialog Set fdg = Application.FileDialog(msoType) With fdg .AllowMultiSelect = False .ButtonName = "Selectionner" .Title = strtitre .InitialFileName = msoPathFileName If .Show = True Then 'Affiche le dlgbox ' traite chaque item ReDim tblresult(.SelectedItems.Count) For Each vrtSelectedItem In .SelectedItems tblresult(i) = vrtSelectedItem i = i + 1 fOuvreFichier = True Next vrtSelectedItem Else ' Cancel. fOuvreFichier = False End If End With Set fdg = Nothing Exit Function Errsub: 'traitement à faire End Function
Concernant fversionproduit() il s'agit juste d'une fonction qui renvoi une string contenant la version de ton application.
Cordialement,