[VBA-A] CommonDialog

Version imprimable

Voir 40 message(s) de cette discussion en une page

15/05/2006, 09h57
Miss Gaelle

Alors en faisant

Code:

Me.commonDlg.Filter = "Fichier Excel|*.xls"

j'ai toujours l'erreur 'Erreur d'exécution 438 : propriété ou méthode non gérée par cet objet' :(
Mais par contre quand je tape Me. avec la complétion auto, il trouve bien commonDlg. Je sais pas si ce genre d'inos aide mais bon.

Quand vous dites que vous voulez voir le code entier, c'est quoi? tout le formulaire?

En fait c'est pas moi qui ai fait cette appli, la personne qui l'a faite n'est plus là. Personne connaît ce langage, et c'est moi qu'on a collé dessus avec une livraison en fin de semaine. A la base le programme était fait pour Windows 2000 et Office 2000. Je fais juste une version compatible pour Windows XP, Office 2003. Ce code fonctionnait bien sur l'ancienne version.

C'est un programme en VBA avec une base de données Access. Désolée je découvre cette technologie en même temps donc parfois je ne suis pas très vive ;)

Pour bbil, quand je fais clique droit / infoExpress sur commonDlg ça m'affiche : commonDlg as CustomControl.

Voici tout mon formulaire Form_frmEnrichissementFregate, je suis désespérée :(

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
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
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
 
Option Compare Database
Option Explicit
Dim xlSheetSelected As Excel.Worksheet
'current tab
Dim currentTab As Integer
Const GENERAL_TAB = 0
Const INJECT_TAB = 1
Const PURGE_TAB = 2
 
'----------------------------------------------------------
'   Form processing
'----------------------------------------------------------
Private Sub btnClose_Click()
  DoCmd.Close
End Sub
Private Sub btnInject_Click()
Dim db As Database
'Dim dbT As Database
Dim qdf As QueryDef
'Dim rsT As Recordset
Dim rs As Recordset
Dim bRet As Boolean
Dim xlApp As Excel.application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim i As Integer
Dim Line As String
Dim nbFields As Long
Dim tmp_enrichi_txt As String
Dim wrkDefault As Workspace
Dim siret As String
 
 
Dim nbDoublons As Long, nbIns As Long, nbUpd As Long
Dim has3 As Boolean
 
    ' control
    If IsNull(txtPathname) Or txtPathname = "" Then
        UI_Error MSG_ERROR, MSG_INPUT_FILE_MANDATORY
        txtPathname.SetFocus
        Exit Sub
    End If
 
    DoCmd.Hourglass True
 
    On Error GoTo err
      'supprime ancienne table
    bRet = DB_bDropTbl("trav_enrichiFREGATE")
    If bRet = False Then
        UI_Error MSG_ERROR, MSG_CANNOT_INIT_TMP
        GoTo fin
    End If
    Call DB_createTblFromStruct("tbl_struct_EnrichiFREGATE", "trav_enrichiFREGATE")
 
    ' store sheet in xls file
    tmp_enrichi_txt = DB_getCurPath + "tmp_enrichi.txt"
    If Dir(tmp_enrichi_txt) <> "" Then Kill tmp_enrichi_txt
 
    ' first remove first line
    On Error GoTo err1
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(txtPathname)
    Set xlSheet = xlBook.ActiveSheet
 
    has3 = True
    With xlSheet
        If .Cells(1, 1) = "" Then
            has3 = False
            Call UI_Error(MSG_ERROR, MSG_ENRICHI_NO_TITLE1)
        End If
        If .Cells(1, 2) = "" Then
            has3 = False
            Call UI_Error(MSG_ERROR, MSG_ENRICHI_NO_TITLE2)
        End If
        If .Cells(1, 3) = "" Then
            has3 = False
            Call UI_Error(MSG_ERROR, MSG_ENRICHI_NO_TITLE3)
        End If
        .Rows("1:1").Delete (xlUp)
       'Set myRange = Worksheets("Sheet1").Range("A1").CurrentRegion
       .Name = "enrichi"
      ' .Range("A1").CurrentRegion.NumberFormat = "@"
    End With
 
 
    xlSheet.SaveAs fileName:=tmp_enrichi_txt, FileFormat:=xlText, CreateBackup:=False
    xlBook.Close False
    xlApp.Quit
    Set xlApp = Nothing
    Set xlSheet = Nothing
 
    If has3 = False Then GoTo fin
 
    On Error GoTo err
 
    ' now import in tmp table
    Set db = CurrentDb
    Set rs = db.OpenRecordset("trav_enrichiFREGATE")
    Open tmp_enrichi_txt For Input As #1
    Do While Not EOF(1)
        Line Input #1, Line
        Debug.Print Line
        Call IMP_getLineFields(Line, Chr(9), nbFields)
        With rs
            .AddNew
            !compte = IMP_fields(0)
            siret = IMP_fields(1)
            If Not IsNumeric(siret) Then
                siret = ""
            Else
                If Len(siret) > 14 Then
                    siret = ""
                End If
            End If
 
            !siret = siret
 
            'patch G1R0C2 : pb quotes en attente
            'If Left(IMP_fields(2), 1) = """" Then
            '    IMP_fields(2) = Right(IMP_fields(2), Len(IMP_fields(2)) - 1)
            'End If
 
            'If Right(IMP_fields(2), Len(IMP_fields(2)) - 1) = """" Then
            '    IMP_fields(2) = Left(IMP_fields(2), Len(IMP_fields(2)) - 1)
            'End If
            'fin patch G1R0C2 : pb quotes
            !client = Left(IMP_fields(2), 50) ' patch G1R0C2 tronque à 50 car.
            .Update
        End With
    Loop
    Close #1
    rs.Close
 
    ' controles doublons
 
    Set rs = db.OpenRecordset("select count(*) from reqDoublons_trav_enrichiFREGATE")
    rs.MoveFirst
    nbDoublons = rs(0)
    rs.Close
 
    If nbDoublons <> 0 Then
        DoCmd.Hourglass False
        DoCmd.OpenForm "frmDoublonsEnrichissement", acNormal, , , , acDialog
        GoTo fin
    End If
 
    ' now process tmp : add ou update tbl_enrichiFREGATE
 
    Set qdf = db.QueryDefs("reqAddEnrichiFregate")
    qdf.Execute
    nbIns = qdf.RecordsAffected
    qdf.Close
 
    Set qdf = db.QueryDefs("reqUpdateEnrichiFregate")
    qdf.Execute
    nbUpd = qdf.RecordsAffected
    qdf.Close
 
    UI_Info MSG_INJECT_SUCCESS, str(nbIns) + " comptes créés, " + str(nbUpd) + " mis à jour"
    GoTo fin
err1:
    Call UI_Error(MSG_ERROR, "Erreur anormale lors de l'injection, Contactez votre support et fournissez lui le message suivant : " + err.Description)
    On Error Resume Next
    xlSheet.SaveAs DB_getCurPath() + "tmp.xls"
    xlBook.Close
    xlApp.Quit
    Set xlApp = Nothing
    Set xlSheet = Nothing
    GoTo fin
err:
    Call UI_Error(MSG_ERROR, err.Description)
    On Error Resume Next
    rs.Close
     Close #1
fin:
    DoCmd.Hourglass False
End Sub
 
'----------------------------------------------------------
'  Manage List actions
'----------------------------------------------------------
'----------------------------------------------------------
'  Manage tab Infos
'----------------------------------------------------------
Private Sub tabInfos_Change()
 
    Select Case tabInfos.value
        Case 0:         ' general
            Me.sfrmTblEnrichi.Requery
            currentTab = GENERAL_TAB
        Case 1:         ' injection
        Case 2:         ' purge
 
    End Select
 
End Sub
 
'----------------------------------------------------------
'  Manage Inject tab
'----------------------------------------------------------
Private Sub btnOpen_Click()
Dim xlApp As Excel.application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim nbSheet As Integer
Dim frm As Form
Dim i As Integer
 
    ' La propriété CancelError a la valeur True.
    On Error GoTo ErrHandler
 
' Définit les filtres.
    commonDlg.Filter = "Fichier Excel|*.xls"
 
    ' Spécifie le filtre par défaut.
    commonDlg.filterIndex = 2
 
    ' Affiche la boîte de dialogue Ouvrir.
    commonDlg.ShowOpen
    ' Appelle la procédure d'ouverture de fichier.
    txtPathname = commonDlg.fileName
 
   Exit Sub
 
ErrHandler:
' L'utilisateur a sélectionné le bouton Annuler.
    Exit Sub
 
End Sub
 
'----------------------------------------------------------
'   Manage purge tab
'----------------------------------------------------------
Private Sub btnPurge_Click()
Dim db As Database
Dim sql As String
Dim bRet As Boolean
 
    On Error GoTo err
 
    bRet = UI_bQuestion(MSG_ATTENTION, MSG_CONFIRM_PURGE_ENRICHI)
    If bRet = False Then
        Exit Sub
    End If
 
    Set db = CurrentDb
    db.Execute ("delete * from tbl_enrichiFREGATE")
 
    Set db = Nothing
    Call UI_Info(MSG_INFO_TITLE, MSG_PURGE_ENRICHI_DONE)
    GoTo fin
err:
    Call UI_Error(MSG_ERROR, err.Description)
fin:
End Sub

15/05/2006, 12h47
SfJ5Rpw8

Citation:

Envoyé par Miss Gaelle

Pour bbil, quand je fais clique droit / infoExpress sur commonDlg ça m'affiche : commonDlg as CustomControl.

Cela ve donc dire que ton objet "commonDlg" n'est pas un commanddialog standard .. ..?
tu peu voir les propriétés disponibles par un clic droit sur une des propriétés (Filter..) puis répertorier les propriétés méthodes...?

peu être la solution est d'effacer ce commondDlg.. et de le remplacer par un commonDialog standard?

Quand je fais un clic droit sur Filter puis Répertorier les propriétés/Méthodes, il m'affiche plein plein de trucs. Mais par exemple, si je fais Commondlg. pour voir les méthodes qu'il propose, il n'y a pas Filter. Mais c'est la même chose dans les formulaires où le code on_Click fontionne.

Un autre truc bizarre, c'est que dans mes formulaires je ne peux pas ajouter de nouveau composant CommonDialog, ni même en copier un existant. J'ai le message suivant :
Code:

1 2 3 "Vous ne possédez pas la licence requise pour l'utilisation de ce controle ActiveX. Vous avez essayé d'ouvrir un formulaire contenant un objet OLE ou un contrôle ActiveX ou de créer un contrôle ActiveX. Pour obtenir la licence appropriée, contactez la société qui fournit l'objet OLE ou le contrôle ActiveX."
Dans les référence, le Microsoft Common Dialog est bien présent. Je fais bien un

Code:

regsvr32 /s %SystemRoot%\system32\comdlg32.ocx

15/05/2006, 14h08
Miss Gaelle
Nouvelle info:
Dans les formulaires où le commondlg fonctionne, quand je fais un clique droit / infoExpress sur commonDlg ça m'affiche :
Code:

1 2 3 CommonDlg As {des-chiffres-et-des-lettres-genre-clé-registre}InForm
Donc je pense qu'il faut que j'arrive à ce que ce soit le même CommonDlg que ci-dessus pour mon formulaire qui marche pas ... mais comment ?
C'est crédible alors comme solution?
15/05/2006, 14h13
SpaceFrog

piste plausible ...
mais tu ne pourras à mon avis pas le faire en mode IDE il te faudra à mon avis editer directeùent le fichier .bas ou .frm avec note pad et coller ça dedans
15/05/2006, 14h24
Miss Gaelle

Tout est compris dans un seul fichier mdb :(
Impossible de voir une déclaration écrite du CommonDlg dans le projet, dans aucun des formulaires qui existent.

Comment puis-je faire pour modifier les propriétés de mon CommonDlg défaillant (Custom) pour qu'il fasse bien appel à la référence VBA ?
15/05/2006, 17h20
SfJ5Rpw8

Citation:

Envoyé par Miss Gaelle

Comment puis-je faire pour modifier les propriétés de mon CommonDlg défaillant (Custom) pour qu'il fasse bien appel à la référence VBA ?

as tu essayer un copie/coller du contrôle...?

j'ai aussi une autre piste, j'ai un probléme similaire sous Excel sur un poste ou VB6 n'est pas installé.. je ne peu pas ajouter des commonDialog.. toujours le probléme de licences.. par contre si je prends le fichier Excel, sur mon poste VB6.. j'y rajoute un commonDialog... ensuite je peu reprendre le Fichier sur le poste "Non-licencié.." et j'ai accés à mon Commondialog.. je peu même en rajouter de nouveaux !! ... Voir si tu peu rajouter le CommonDialog depuis un autre PC .. (avec VB6..) ou trouve une âme charitable qui puisse le faire pour toi .. ( j'ai pas d'access 2000.. ) ..
15/05/2006, 19h21
jmfmarques

Je suis têtu, mais ...
Mon code dans un module ... et c'en est fini de cette "dépendance" à un contrôle !:lol:
Et en plus, quand j'y pense... plus rapide à l'exécution (API)...;)

Cher taureau, je comprends ton entêtement ;) Mais j'arrive pas vraiment à comprendre toute l'"architecture" d'une appli VB.

Alors au final, hier j'ai passé la journée dessus, notament avec BWP et Spafy (merci à eux pour leur patience et leur disponibilité). Il s'est avéré que j'ai utilisé l'objet FileDialog pour pallier à tout ça (normallement ça marche il me reste quelques tests à faire ce matin).

Bbil, je comprends quand même pas cette histoire de licence. C'est normal? C'est quand même super handicapant et contraignant : obligée de bidouiller dans tous les sens :(

Je vous tiens au courant : vais-je livrer à temps? suspense ... ;)
Merci beaucoup à vous tous en tout cas! :)

PS: Voici un extrait de code du formulaire, si jamais un jour quelqu'un à ce souci, cela pourra éventuellement aider:
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 '---------------------------------------------------------- ' Manage Inject tab '---------------------------------------------------------- Private Sub btnOpen_Click() Dim Fd As FileDialog Dim SelectedFile As Variant Set Fd = FileDialog(msoFileDialogOpen) With Fd .AllowMultiSelect = True .ButtonName = "Ouvrir" .Filters.Clear .Filters.Add "Documents Excel", "*.xls", 1 .FilterIndex = 1 .InitialFileName = "" .InitialView = msoFileDialogViewList .title = "sélectionnez un fichier" If .Show Then For Each SelectedFile In .SelectedItems txtPathname = SelectedFile Next SelectedFile End If End With Set Fd = Nothing End Sub

16/05/2006, 16h25
Miss Gaelle

C'est bel et bien résolu et livré au client ;)
Merci à tous pour votre aide :)
17/05/2006, 00h25
ThierryAIM

:bravo:

Voir 40 message(s) de cette discussion en une page