Discussion :

[Décibel]

J'ai une très grosse apli...

J'utilise des sorties vers des documents excels, word avec des signets, outlook pour créer des emails...
Il y a des centaines de lignes...
Et en fait je n'ai pas de message d'erreur si ce n'est des requêtes qui ne marchent pas avec des erreurs sur format() ou champ dates...

Code ouverture de word :

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
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
 ' Ouverture de word
        Dim oApp As Object
        Set oApp = CreateObject("Word.Application")
        oApp.Visible = True
 
        Dim vl_WordDoc_Obj As Object
        ExisteSignet = True
        Set vl_WordDoc_Obj = GetObject(, "Word.Application")
 
 
        If Vl_LanceWord_Bo = True Then
        Vl_ValRet = Shell("Winword", vbMinimizedNoFocus)
        Beep
        MsgBox "L'application vient de lancer Word. Renouveler votre demande pour créer votre document.", , Vg_ApplicationName_$
        Exit Function
        End If
 
   On Error GoTo Err_Bt_NewPRA_Click
    Dim db As Database
    Dim rs, rsc, RsAf As Recordset
    Dim NomDoc As String
    Dim SQL As String
    Set db = CurrentDb

Code email :

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
Public Sub CreateEmail(Recipient As String, Subject As String, Body As String, Optional Attach As Variant)
    Dim message As String
    Dim i As Integer
    ' créer un nouvel item mail
    Set myOlApp = CreateObject("Outlook.Application")
    Set oEmail = myOlApp.CreateItem(olMailItem)
 
    'Set oEmail = appOutLook.CreateItem(olMailItem)
    ' les paramètres
    oEmail.To = G_EmailRecipient
    oEmail.Subject = G_EmailSubject
    oEmail.Body = G_EmailBody
 
   ' envoie le message
oEmail.Display
End Sub

Code export de requête :

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
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
 
    t0 = Timer
    Dim rec As Recordset
 
    If Form_ChoixEditionFiches_Clients.Cocher79 = True Then
        Set rec = CurrentDb.OpenRecordset("Export_clients", dbOpenSnapshot)
    Else
        Set rec = CurrentDb.OpenRecordset("Export_clients_all", dbOpenSnapshot)
    End If
 
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.name = "Tutoriel"
 
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Export journal des ventes"
 
 
    ' 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
        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)
            Else
                xlSheet.Cells(i, J + 1) = rec.Fields(J)
            End If
        Next J
        i = i + 1
        rec.MoveNext
    Loop
 
    ' code de fermeture et libération des objets
    xlBook.SaveAs "c:\dbcmanager\Clients-manager.xls"
    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"
 
End Function

[argyronet]

Humm, il y a des choses qui me sautent aux yeux comme un coup de pied dans le derrière...

Quand tu emploies du CreateObject() tu ne dois pas déclarer ta variable en fonction de la référence mais As Object...
Tu décoches alors la référence.

Dans tes blocs de code figurent majoritairement du CreateObject() donc il est inutile de référencer pour ton cas actuel, Word et Outlook...
Pour Excel, procède de façon identique et déclarant en objet.

Dans l'absolu et pour "confortabiliser" ton écriture de code (intellisense) tu coches les réfs puis une fois fini, tu passes en objet tes variables, par exemple :

Code :

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

Dim oXLApp As Object 'Excel.Application

Supprime alors toutes les références et réessaye.

Ah puis autre chose, le VBADeous a inventé l'Option Explicit et les gestions d'erreurs. Je pense que ton appli devrait y avoir le droit surtout quand il s'agit "d'une Très Grosse Application" comme tu dis si bien...

Sache encore qu'un objet est consommateur de ressource et qu'en fin d'usage, il se voit affecté Nothing et si c'est un objet DAO, il doit être fermé. ce n'est pas toujours la cas dans le peu de code que tu présentes donc, je suppose par avance le reste des autres modules sont concernés aussi...

Argy

[Décibel]

Nous y sommes...
En fait j'utilise le web pour trouver des bouts de codes qui me permettent d'avancer, puis je met en place tout ce qu'il faut pour arriver à mon résultat...
Je suis un autodidacte et je n'ai jamais suivi de cours de programmation.
Alors les premières lignes de mon code genre :

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
 ' Ouverture de word
        Dim oApp As Object
        Set oApp = CreateObject("Word.Application")
        oApp.Visible = True
 
        Dim vl_WordDoc_Obj As Object
        ExisteSignet = True
        Set vl_WordDoc_Obj = GetObject(, "Word.Application")
 
 
        If Vl_LanceWord_Bo = True Then
        Vl_ValRet = Shell("Winword", vbMinimizedNoFocus)
        Beep
        MsgBox "L'application vient de lancer Word. Renouveler votre demande pour créer votre document.", , Vg_ApplicationName_$
        Exit Function
        End If

Je n'y comprend pas grand chose...
Une chose est certaine si je décoche dans la liste des ref word, excel et outlook, la compile bug sur

Code :

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

Dim xlApp As Excel.Application

OU

Code :

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

Dim wrd As New Word.Application

et que si je pouvais remplacer tout cela par un autre code qui ne fait plus appel au ref j'en serai ravis...

Donc voici ma question, je n'ai pas bien compris comment tu peux remplacer word.application ou excel application dans le code suivant (par exemple), si tu peux m'aider ce serait plus que cool

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
    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
    
    t0 = Timer
    Dim rec As Recordset
    
    If Form_ChoixEditionFiches_Clients.Cocher79 = True Then
        Set rec = CurrentDb.OpenRecordset("Export_clients", dbOpenSnapshot)
    Else
        Set rec = CurrentDb.OpenRecordset("Export_clients_all", dbOpenSnapshot)
    End If
    
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
   
    'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
    xlSheet.name = "Tutoriel"
   
    ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
    xlSheet.Cells(1, 1) = "Export journal des ventes"
   
    
    ' 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
        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)
            Else
                xlSheet.Cells(i, J + 1) = rec.Fields(J)
            End If
        Next J
        i = i + 1
        rec.MoveNext
    Loop
   
    ' code de fermeture et libération des objets
    xlBook.SaveAs "c:\dbcmanager\Clients-manager.xls"
    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"

End Function

[argyronet]

Humm, perso, je ne coderais pas ce type de procédure ainsi, car je suis pro-générique et réutilisable mais avec une tite retouche, voilà ce que ça donne...

Quand tu décoches les réf, il faut déclarer toutes les constantes utilisées dans ton code (pour la circonstance) qui sont intrinsèquement connues lorsque le référence est cochée.

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
Option Compare Database
Option Explicit
 
Sub ExportJournalVentes()
Const WORKBOOK_FILENAME = "c:\dbcmanager\Clients-manager.xls"
 
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8
Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlSolid = 1
Const xlCenter = -4108
 
Dim xlApp                                         As Object    'Excel.application
Dim xlSheet                                       As Object    'Excel.Worksheet
Dim xlBook                                        As Object    'Excel.Workbook
Dim rec                                           As DAO.Recordset
Dim I                                             As Long
Dim J                                             As Long
Dim t0                                            As Long
Dim t1                                            As Long
 
    On Error GoTo ExportJournalVentes_Error
 
    t0 = Timer
    ' Cocher79 a renommer !!!
'    If Form_ChoixEditionFiches_Clients.Cocher79 = True Then
'        Set rec = CurrentDb.OpenRecordset("Export_clients", dbOpenSnapshot)
'    Else
'        Set rec = CurrentDb.OpenRecordset("Export_clients_all", dbOpenSnapshot)
'    End If
 
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    If Not xlApp Is Nothing Then
        With xlApp
            .DisplayAlerts = False
        End With
        Set xlBook = xlApp.Workbooks.Add
        'Ajouter une feuille de calcul
        Set xlSheet = xlBook.Worksheets.Add
        xlSheet.Name = "Tutoriel"
        ' le titre
        ' écriture dans la cellule de ligne 1 et de colonne 1
        xlSheet.Cells(1, 1) = "Export journal des ventes"
 
        ' 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
            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)
                Else
                    xlSheet.Cells(I, J + 1) = rec.Fields(J)
                End If
            Next J
            I = I + 1
            rec.MoveNext
        Loop
        rec.Close
        'Sauvegarde du classeur
        If Dir(WORKBOOK_FILENAME, vbNormal) <> "" Then Kill WORKBOOK_FILENAME
        With xlBook
            .SaveAs WORKBOOK_FILENAME
            .saved = True
            .Close
        End With
        ' code de fermeture et libération des objets
        xlApp.Quit
        t1 = Timer
        'Debug.Print I & " enregistrements", Format(t1 - t0, "0") & " secondes"
        On Error GoTo 0
    End If
 
    On Error GoTo 0
ExportJournalVentes_Exit:
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub
ExportJournalVentes_Error:
    MsgBox Err.Description, 48, Err.Source
    Resume ExportJournalVentes_Exit
End Sub

Argy

[Décibel]

Arrggg !!!

Pas tout compris, mais un peu...

J'ai mis ton code dans une base vide sans aucune ref, j'ai compilé et effectivement plus de problème avec Excel.application, bien qu'il soit présent dans CreateObject ???

par contre en compilant j'ai une erreur sur xlContinuous ???
As tu une idée ?

En gros la règle que tu appliques est de ne pas déclarer une variable en .application, mais de la garder en simple Objet.
Il me faudra donc tout réécrire mon code de toutes les pages pour remplacer ses variables...
Gros travail mais à tester !
Merci...

[argyronet]

C'est une omission de ma part...
Il faut déclarer aussi la constante :

Code :

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

Const xlContinuous = 1

Et toutes celles de Word et d'Outlook dans le même esprit.
Pour ce faire, tu pointes la constante dans ton code (la référence étant encore cochée) et tu appuies sur Shift+F2...
De la tu arrives sur l'Explorateur d'objets et tu as la constante qu'il te reste plus qu'à copier/coller dans ton code...

Argy

[Décibel]

Merci Argy, je vais essayer...
Toutes mes excuses sur mon cris de guerre, gorge nouée qui était arrggg et qui pourrait donner une fausse idée en liaison avec ton nom.

[Décibel]

Tout marche parfaitement, j'en ai profité pour rendre plus propre certains développement !!!

Merci !!!