Discussion :

[Almenor]

Bonjour,

Je suis en train de créer une petite application Access pour le boulot, la dernière fois que j'y ai chipoter tout fonctionnait à merveille.

Aujourd'hui, je veux avancer un peu dans mon appli, et là j'ai un formulaire qui ne veut plus s'ouvrir et fait planter Access, et même chose quand je veux modifier le code VBA de ce formulaire, dès que je veux faire la moindre modification, même simplement commenter le code, Access plante...

J'ai déjà tenter la solution présentée ici : http://www.developpez.net/forums/d11...e-fonctionner/

Sans succès...

J'espère que je ne vais pas devoir tout recommencer...

Au cas ou ça peut aider, voici le code VBA du formulaire en question :

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
 
Option Compare Database
 
'Action lors de l'ouverture du formulaire
Private Sub Form_Open(Cancel As Integer)
 
    Actualise
 
End Sub
 
'Gestion des images du formulaire
Private Function Actualise()
    If IsNull(lien1) Or lien1 = "" Then
        btn_lien1.Picture = ""
        btn_lien1.Height = 500
        croix1.Visible = False
    Else
        btn_lien1.Picture = SetPicture(lien1)
        btn_lien1.Height = 1500
        croix1.Visible = True
    End If
 
    If IsNull(lien2) Or lien2 = "" Then
        btn_lien2.Picture = ""
        btn_lien2.Height = 500
        croix2.Visible = False
    Else
        btn_lien2.Picture = SetPicture(lien2)
        btn_lien2.Height = 1500
        croix2.Visible = True
    End If
 
    If IsNull(lien3) Or lien3 = "" Then
        btn_lien3.Picture = ""
        btn_lien3.Height = 500
        croix3.Visible = False
    Else
        btn_lien3.Picture = SetPicture(lien3)
        btn_lien3.Height = 1500
        croix3.Visible = True
    End If
End Function
 
'Fonction qui permet de choisir l'image en fonction du fichier
Private Function SetPicture(lien) As String
 
    Dim extention As String
    Dim image As String
    Dim lenght As Integer
 
    Dim path As String
    path = "C:\data\2015\SIPCOM\Images\"
 
    'MsgBox lien
    lenght = Len(lien)
    extention = Mid(lien, lenght - 3, 4)
    'MsgBox extention
    Select Case extention
        Case "docx", ".doc"
            image = path + "word.jpg"
        Case "xlsx", ".xls"
            image = path + "excel.jpg"
        Case ".pdf"
            image = path + "pdf.jpg"
    End Select
    'MsgBox image
    SetPicture = image
 
End Function
 
'Gestion du bouton du lien 1
Private Sub btn_lien1_Click()
 
    If IsNull(lien1) Or lien1 = "" Then
        lien1 = OuvrirUnFichier(Application.hWndAccessApp, "Parcourir", 1, , , "P:\DEPARTEMENT MARKETING ET COMMUNICATION")
        If Len(lien1) > 1 Then
            btn_lien1.Picture = SetPicture(lien1)
            btn_lien1.Height = 1500
            croix1.Visible = True
            txt_date.SetFocus
        End If
    Else
        Dim ouvrir As String
        ouvrir = fHandleFile(lien1, WIN_NORMAL)
    End If
 
End Sub
 
'Gestion du bouton du lien 2
Private Sub btn_lien2_Click()
 
    If IsNull(lien2) Or lien2 = "" Then
        lien2 = OuvrirUnFichier(Application.hWndAccessApp, "Parcourir", 1, , , "P:\DEPARTEMENT MARKETING ET COMMUNICATION")
        If Len(lien2) > 1 Then
            btn_lien2.Picture = SetPicture(lien2)
            btn_lien2.Height = 1500
            croix2.Visible = True
            txt_date.SetFocus
        End If
    Else
        Dim ouvrir As String
        ouvrir = fHandleFile(lien2, WIN_NORMAL)
    End If
 
End Sub
 
'Gestion du bouton du lien 3
Private Sub btn_lien3_Click()
 
    If IsNull(lien3) Or lien3 = "" Then
        lien3 = OuvrirUnFichier(Application.hWndAccessApp, "Parcourir", 1, , , "P:\DEPARTEMENT MARKETING ET COMMUNICATION")
        If Len(lien3) > 1 Then
            btn_lien3.Picture = SetPicture(lien3)
            btn_lien3.Height = 1500
            croix3.Visible = True
            txt_date.SetFocus
        End If
    Else
        Dim ouvrir As String
        ouvrir = fHandleFile(lien3, WIN_NORMAL)
    End If
 
End Sub
 
'Bouton de suppression du lien 1
Private Sub croix1_click()
 
    If MsgBox("Voulez-vous supprimer cette pièce jointe ? (Cette action supprime uniquement la liaison vers la pièce jointe et ne supprime pas le fichier sur le disque)", vbYesNo, "Suppression pièce jointe") = 6 Then
        lien1 = ""
        btn_lien1.Picture = ""
        btn_lien1.Height = 500
        croix1.Visible = False
    End If
 
End Sub
 
'Bouton de suppression du lien 2
Private Sub croix2_click()
 
    If MsgBox("Voulez-vous supprimer cette pièce jointe ? (Cette action supprime uniquement la liaison vers la pièce jointe et ne supprime pas le fichier sur le disque)", vbYesNo, "Suppression pièce jointe") = 6 Then
        lien2 = ""
        btn_lien2.Picture = ""
        btn_lien2.Height = 500
        croix2.Visible = False
    End If
 
End Sub
 
'Bouton de suppression du lien 3
Private Sub croix3_click()
 
    If MsgBox("Voulez-vous supprimer cette pièce jointe ? (Cette action supprime uniquement la liaison vers la pièce jointe et ne supprime pas le fichier sur le disque)", vbYesNo, "Suppression pièce jointe") = 6 Then
        lien3 = ""
        btn_lien3.Picture = ""
        btn_lien3.Height = 500
        croix3.Visible = False
    End If
 
End Sub
 
'Actions losque l'on change d'enregistrement
Private Sub Form_Current()
    Actualise
End Sub

[Almenor]

Problème résolu, j'ai copier la DB dans un autre dossier, j'ai effacer le formulaire qui pose problème et importer ce formulaire depuis la bd copiée... Et plus de problème... Par contre la DB copiée continue à bug.

Je ne comprends pas ce qui c'est passé...