Discussion :

[surrounded]

Bonjour a tous , j'ai un petit problème avec mon application acces en vba. J'ai une table que je transfert dans un fichier excel avec différent champ. avec les nombreux tuto jai reussi a faire en sorte que mes champs garde leur format et jai appliquer la mise en forme d'hyperlien au lien des photos qui sont compris sous 3 champs. Le code et générer par le clic dun bouton dans mon menu principal. Lors dun premier clic le code fonctionne et les hyperliens sont créer.

Par contre si je clic une deuxième fois le code échoue avec une erreur bizarre que je narrivais pas a comprendre. J'ai reussi a trouver la source d'erreur mais je narrive pas a corriger celle-ci.

Après le premiere clic il mest possible de voir dans le gestionnaire de tâche qu'une application excel est ouverte. Quand elle est la le 2e clic echoue. Jai essaye en terminant manuellement le processus dans le gestionnaire de tâche et le 2e clic fontionne. Donc j'imagine qu'il y a une erreur de fermeture de l'application ou quelque chose du genre voici mon code:

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
 
 
 
Private Sub excel_Click()
 
 
    Dim xlApp As excel.Application
    Dim xlSheet As excel.Worksheet
    Dim xlBook As excel.Workbook
    Dim I As Long, J As Long
    Dim t0 As Long, t1 As Long
    Dim lien As String
 
    t0 = Timer
    Dim rec As Recordset
    Set rec = CurrentDb.OpenRecordset("histotest", dbOpenSnapshot)
 
    If Not rec.EOF Then
 
    'Initialisations
    Set xlApp = CreateObject("excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.Name = Date
 
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Export de la table historique"
 
 
    ' les entetes
    '  .Fields(Index).Name renvoie le nom du champ
 
    For J = 0 To rec.Fields.Count - 1
        xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(2, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
            .AutoFormat
            .AutoFilter
        End With
    Next J
 
 
    ' recopie des données à partir de la ligne 3
    I = 3
    Do While Not rec.EOF
        For J = 0 To rec.Fields.Count - 1
 
            ' .Fields(Index).Type renvoie le type du champ
            '   si c'est un Texte (dbText) nous insérons "'" pour
            '   qu'il soit reconnu par Excel comme du Texte
            If rec.Fields(J).Type = dbText Then
                xlSheet.Cells(I, J + 1) = "'" & rec.Fields(J)
                xlSheet.Cells(I, J + 1).AutoFormat
 
                'Transforme le texte en hyperlien
                If J = 8 Or J = 9 Or J = 10 Or J = 11 Then
 
                lien = xlSheet.Cells(I, J + 1).Text
                xlSheet.Cells(I, J + 1).Select
 
                xlSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
                lien _
                , TextToDisplay:= _
                lien
 
                'Selection.Font.Underline = xlUnderlineStyleSingle
                'Selection.Font.ColorIndex = 5
 
                End If
 
 
            Else
                'si c'Est une date (dbDate) nous spécifions le format
                'de date que excel doit prendre
               If rec.Fields(J).Type = dbDate Then
                xlSheet.Cells(I, J + 1).NumberFormat = "m/d/yyyy"
                xlSheet.Cells(I, J + 1) = rec.Fields(J)
                xlSheet.Cells(I, J + 1).AutoFormat
 
                Else
                xlSheet.Cells(I, J + 1) = rec.Fields(J)
                xlSheet.Cells(I, J + 1).AutoFormat
                End If
            End If
        Next J
        I = I + 1
        rec.MoveNext
    Loop
 
    ' code de fermeture et libération des objets
 
 On Error GoTo errexcel
 
    Dim nomexcel As String
    Dim dated As String
    dated = Date
 
    nomexcel = CurrentProject.Path & "\historique\Backuphistorique-" + dated + ".xls"
 
 
    xlBook.SaveAs nomexcel
 
    xlBook.Close
    xlApp.Quit
 
    rec.Close
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
 
    t1 = Timer
    Debug.Print I & " enregistrements", Format(t1 - t0, "0") & " secondes"
    MsgBox "Table Historique Enregistrer"
 
    DoCmd.OpenForm "menu principal", acDesign, , , , acHidden
    Forms![menu principal]![excel].Caption = "Transfert Excel " + dated
    DoCmd.Close acForm, "menu principal", acSaveYes
    DoCmd.OpenForm "menu principal"
 
 
    Else
    MsgBox "Table Historique vide"
    End If
   Exit Sub
 
 
errexcel:
MsgBox "La table n'a pas été enregistrée"
 
xlBook.Close
xlApp.Quit
    rec.Close
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
 
End Sub

Quelqu'un aurait une idée?????

Merci d'avance

[surrounded]

Petit info jai clairement remarqué que l'erreur vien directement du code lorsque je créé mes hyperliens. J'ai masqué les lignes et le boutons marche a merveille a plusieurs reprises donc quelque chose ne va pas de ce cote la.

Code :

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

1
2
3
4
5
 
lien = xlSheet.Cells(I, J + 1).Text
xlSheet.Cells(I, J + 1).Select
 
xlSheet.Hyperlinks.Add Anchor:=Selection, Address:= lien, TextToDisplay:= _ lien

est-ce que quel'qun voit une erreur??

[surrounded]

bon et bien j'ai réglé le problème en obligeant la fermeture de access de cette façon excel est fermé en même dans dans le gestionnaire de tâche donc c la seule façon que j'ai réussi