Discussion :

[Yotho]

Bonjour tout le monde je pense que mon titre est assez explicite ... j'aimerais à l'aide du contrôle Microsoft common dialog faire afficher une boite de dialogue de type OUVRIR/ENREGISTRER mais le problème c'est que je n'arrive pas à l'utiliser sur vba .... (alors que ça marche très bien sur VB6)........

[muse19]

alors je te conseille de créer un module de classe avec le code suivant

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
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
Option Compare Database
Option Explicit
 
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
Private Declare Function GetOpenFileName _
    Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" _
    (pOpenfilename As OPENFILENAME) _
    As Long
 
Private Declare Function GetSaveFileName _
    Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" _
    (pOpenfilename As OPENFILENAME) _
    As Long
 
Private m_strDefaultExt As String
Private m_strDialogTitle As String
Private m_strFileName As String
Private m_strFileTitle As String
Private m_strInitialDir As String
Private m_strFilter As String
Private m_intFilterIndex As Integer
Private m_intMaxFileSize As Integer
Private m_lnghWndParent As Long
 
Private Const cintMaxFileLength As Integer = 260
 
Public Property Get DefaultExt() As String
    DefaultExt = m_strDefaultExt
End Property
 
Public Property Let DefaultExt(ByVal strValue As String)
    m_strDefaultExt = strValue
End Property
 
Public Property Get DialogTitle() As String
    DialogTitle = m_strDialogTitle
End Property
 
Public Property Let DialogTitle(ByVal strValue As String)
    m_strDialogTitle = strValue
End Property
 
Public Property Get FileName() As String
    FileName = m_strFileName
End Property
 
Public Property Let FileName(ByVal strValue As String)
    m_strFileName = strValue
End Property
 
Public Property Get FileTitle() As String
    FileTitle = m_strFileTitle
End Property
 
Public Property Let FileTitle(ByVal strValue As String)
    m_strFileTitle = strValue
End Property
 
Public Property Get Filter() As String
    Filter = m_strFilter
End Property
 
Public Property Let Filter(ByVal strValue As String)
    m_strFilter = strValue
End Property
 
Public Property Get FilterIndex() As Integer
    FilterIndex = m_intFilterIndex
End Property
 
Public Property Let FilterIndex(ByVal intValue As Integer)
    m_intFilterIndex = intValue
End Property
 
Public Property Get hWndParent() As Long
    hWndParent = m_lnghWndParent
End Property
 
Public Property Let hWndParent(ByVal lngValue As Long)
    m_lnghWndParent = lngValue
End Property
 
Public Property Get InitialDir() As String
    InitialDir = m_strInitialDir
End Property
 
Public Property Let InitialDir(ByVal strValue As String)
    m_strInitialDir = strValue
End Property
 
Public Property Get MaxFileSize() As Integer
    MaxFileSize = m_intMaxFileSize
End Property
 
Public Property Let MaxFileSize(ByVal intValue As Integer)
    m_intMaxFileSize = intValue
End Property
 
Public Function Show(fOpen As Boolean) As Boolean
 
    Dim of As OPENFILENAME
    Dim strChar As String * 1
    Dim intCounter As Integer
    Dim strTemp As String
 
    On Error GoTo PROC_ERR
 
    of.lpstrTitle = m_strDialogTitle & ""
    of.Flags = &H80000
    of.lpstrDefExt = m_strDefaultExt & ""
    of.lStructSize = LenB(of)
    of.lpstrFilter = m_strFilter & "||"
    of.nFilterIndex = m_intFilterIndex
 
    For intCounter = 1 To Len(m_strFilter)
    strChar = Mid$(m_strFilter, intCounter, 1)
    If strChar = "|" Then
        strTemp = strTemp & vbNullChar
    Else
        strTemp = strTemp & strChar
    End If
    Next
 
 
    strTemp = strTemp & vbNullChar & vbNullChar
    of.lpstrFilter = strTemp
 
    strTemp = m_strFileName & String$(cintMaxFileLength - Len(m_strFileName), 0)
    of.lpstrFile = strTemp
    of.nMaxFile = cintMaxFileLength
 
    strTemp = m_strFileTitle & String$(cintMaxFileLength - Len(m_strFileTitle), 0)
    of.lpstrFileTitle = strTemp
    of.lpstrInitialDir = m_strInitialDir
    of.nMaxFileTitle = cintMaxFileLength
    of.hwndOwner = m_lnghWndParent
 
    If fOpen Then
        If GetOpenFileName(of) Then
            Show = True
            m_strFileName = TrimNulls(of.lpstrFile)
            m_strFileTitle = TrimNulls(of.lpstrFileTitle)
        Else
            Show = False
        End If
    Else
        If GetSaveFileName(of) Then
            Show = True
            m_strFileName = TrimNulls(of.lpstrFile)
            m_strFileTitle = TrimNulls(of.lpstrFileTitle)
        Else
            Show = False
        End If
    End If
 
PROC_EXIT:
    Exit Function
 
PROC_ERR:
    MsgBox "Error: " & err.Number & ". " & err.Description, , _
    "Show"
    Resume PROC_EXIT
 
End Function
 
Private Function TrimNulls(ByVal strIn As String) As String
    Dim intPos As Integer
 
    On Error GoTo PROC_ERR
 
    intPos = InStr(strIn, vbNullChar)
 
    If intPos = 0 Then
    TrimNulls = strIn
    Else
    If intPos = 1 Then
        TrimNulls = ""
    Else
        TrimNulls = Left$(strIn, intPos - 1)
    End If
    End If
 
PROC_EXIT:
    Exit Function
 
PROC_ERR:
    MsgBox "Error: " & err.Number & ". " & err.Description, , _
    "TrimNulls"
    Resume PROC_EXIT
 
End Function

et ensuite dans les formulaires par exemple dans lesquels tu veux utiliser ca tu insères

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim dlg As CFileDialog
Set dlg = New CFileDialog
dlg.DialogTitle = "Choisissez une balance d'importation"
dlg.Filter = "Balance d'importation Format Text|*.txt"
dlg.InitialDir = "C:\"
 
If dlg.Show(True) Then
----    
 
Else
    MsgBox "Aucun fichier sélectionné."
End If

[Yotho]

Merci ca marche bien !!!

[muse19]

LOLLLLLL

tu mets résolu s'il te plait
:-)

[wperezrobles]

En faisant un copier/coller de tes sources, il me met une erreur sur Mid$ ....
(bibliothèque introuvable).

Faut-il importer quelque chose dans mon projet ?

NB : Je suis novice dans le dev ACCESS/VB

[acorna]

Salut,

Les bibliothèques ActiveX Data Objects et DAO sont généralement conseillées =)