Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Access > VBA Access
VBA Access Le forum pour les questions relatives au code VBA sous Access, et à son environnement de développement VBE.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 18/11/2010, 17h15   #1
Expert Confirmé
 
Avatar de Godzestla
 
Homme
Chercheur de bonheur
Inscription : août 2007
Messages : 2 253
Détails du profil
Informations personnelles :
Sexe : Homme
Âge : 47
Localisation : Belgique

Informations professionnelles :
Activité : Chercheur de bonheur
Secteur : Industrie

Informations forums :
Inscription : août 2007
Messages : 2 253
Points : 2 973
Points : 2 973
Par défaut problème interfacage avec Word : présentation étrange de word

Bonjour,

Depuis access je constitue le corps d'un document word en utilisant des signets pour remplir des zones à contenu variables.

Lorsque le document word est constitué, soit je montre le document en print preview, soit je laisse word caché et je génére la version de ce document en PDF que j'affiche ensuite.

le code ci-dessous fonctionne sans problème depuis des années mais depuis peu, lorsque je l'utilise il ouvre systématiquement 2 instances de word, une première avec le document en tant que tel et une deuxième avec le print preview alors qu'avant je n'avait comme souhaité que le print preview. Quand je ferme le printpreview, comme prévu par mon code cela continue plus ou mojns normallement. Quand je touche à la fenêtre avec document normal, tout le word se ferme et parfois crash sur certaines machines. parfois on obtient un message comme quoi le fichier normal.dot est utilisé ou bloqué par une autre instance de word.

Je ne comprends pas ce qui ne fonctionne plus.

Si quelqu'un peut m'aider, j'en ai grand besoin car tous les documents de l'appli sont générés de cette manière.

Ce qui me semble étrange, c'est que l'instruction que j'ai mise en gras semble me renommer l'instance de word qui n'apparaissait pas avant en False. (je vois false dans la barre de tache pour cette instance).

Il y certainement une grosse erreur dans mon code, mais où ?
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
 
Public Sub CreateMed(word_flag As Boolean, pdf_flag As Boolean, Student_Name As String, center As String, Date_From As String, Date_To As String, Invoice As String)
    Dim recv As Recordset
    Dim Reci As Recordset
    Dim Dbv  As Database
    Dim document As String
    Dim Reference As String
    Dim Pdfdoc As String
    Dim NewPdfdoc As String
    Dim checkup   As String
    Dim Model     As String
 
 
    'Reference Current Database
 
    Set Dbv = DBEngine.Workspaces(0).Databases(0)
 
    'Open Recordset Zcontrol and get 1st record
 
    Set recv = Dbv.OpenRecordset("SQL_Zcontrol", , dbReadOnly)
    recv.FindFirst "DB_Year > 0"
 
    If recv.EOF Then GoTo exit_create_Travel
 
    Reference = Trim(Invoice) & Trim(recv![Inv_pre])
    If IsNull(Reference) Then Reference = " "
 
    'Open Recordset Installations  and get 1st record
 
    Set Reci = Dbv.OpenRecordset("SQL_Installation_Lines", , dbReadOnly)
    Reci.FindFirst "Install_Nr > 0"
 
    If Reci.EOF Then GoTo exit_create_Travel
 
    Model = Trim(recv![Model_Folder]) & Trim(recv![Medical_Model_Name])
    checkup = Dir(Model, vbHidden)
 
    If checkup = "" Then
        checkup = MsgBox("Model file " & Model & " missing. Operation not possible", vbCritical, "Oops")
        GoTo exit_create_Travel
    End If
 
    ' instantiate the word application and create a new
    ' document based upon the supplied template
    Set m_objWord = New Word.Application
 
    Set m_objDoc = m_objWord.Documents.Add(Model, , , True)
 
    ' insert the Student details
    InsertTextAtBookMark "Student_Name", Student_Name
    InsertTextAtBookMark "Center", center
    InsertTextAtBookMark "Arrival_Date", Date_From
    InsertTextAtBookMark "Departure_Date", Date_To
    InsertTextAtBookMark "reference", Reference
 
    'Save File required before closing to prevent a window at exit
    document = Trim(recv![Generated_Folder]) & Student_Name & "_Medical.DOC"
    'Insert Filename in header
    InsertTextAtBookMark "Filename", Student_Name & "_Medical.DOC"
    On Error Resume Next
    Kill document
 
    m_objDoc.SaveAs Filename:=document
 
        Select Case True
           Case pdf_flag
                m_objDoc.Application.Run ("Module1.Converttopdf_Silent")
                Pdfdoc = Trim(recv![Generated_Folder]) & Student_Name & "_Medical.PDF"
                NewPdfdoc = Trim(recv![Generated_Acrobat_Folder]) & Student_Name & "_Medical.PDF"
                FileCopy Pdfdoc, NewPdfdoc
                Kill Pdfdoc
                PhWnd = OpenProgram(NewPdfdoc, 0)
           Case word_flag
                 'Set word in visible state
                m_objWord.Visible = True
                'Activate Word and printpreview the created document
                m_objDoc.Activate
                'Print Preview the document
                m_objDoc.PrintPreview
                 'Wait for printpreview window closed
                Do While m_objWord.PrintPreview = True
                Loop
    End Select
 
 
    'Close all words instances
    m_objDoc.ActiveWindow = False
 
    On Error Resume Next
    m_objDoc.Close
 
    recv.Close
    Reci.Close
 
    On Error Resume Next
    m_objWord.Quit
 
    Set m_objDoc = Nothing
 
exit_create_Travel:
End Sub
__________________
(\ _ /) Cordialement G@dz
(='.'=)

(")-(") Vous avez des neurones. Sollicitez-les. . Si vous êtes aidé, pensez à Voter.
Godzestla est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 19/11/2010, 13h31   #2
Expert Confirmé
 
Avatar de Godzestla
 
Homme
Chercheur de bonheur
Inscription : août 2007
Messages : 2 253
Détails du profil
Informations personnelles :
Sexe : Homme
Âge : 47
Localisation : Belgique

Informations professionnelles :
Activité : Chercheur de bonheur
Secteur : Industrie

Informations forums :
Inscription : août 2007
Messages : 2 253
Points : 2 973
Points : 2 973
Bon, bien j'ai trouvé une solution comme un grand, au cas où cela intéresse quelqu'un.



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
Public Sub CreateTravel(word_flag As Boolean, pdf_flag As Boolean, Student_Name As String, center As String, Date_From As String, Date_To As String, Invoice As String)
    Dim recv As Recordset
    Dim Reci As Recordset
    Dim Dbv  As Database
    Dim doc  As String
    Dim Reference As String
    Dim Pdfdoc As String
    Dim NewPdfdoc As String
    Dim checkup   As String
    Dim Model     As String
    Dim fichier
    
    
    
    'Reference Current Database
    
    Set Dbv = DBEngine.Workspaces(0).Databases(0)
    
    'Open Recordset Zcontrol and get 1st record
    
    Set recv = Dbv.OpenRecordset("SQL_Zcontrol", , dbReadOnly)
    recv.FindFirst "DB_Year > 0"
    
    If recv.EOF Then GoTo exit_create_Travel
    
    Reference = Trim(Invoice) & Trim(recv![Inv_pre])
    If IsNull(Reference) Then Reference = " "
    
    'Open Recordset Installations  and get 1st record
    
    Set Reci = Dbv.OpenRecordset("SQL_Installation_Lines", , dbReadOnly)
    Reci.FindFirst "Install_Nr > 0"
    
    If Reci.EOF Then GoTo exit_create_Travel
    
    Model = Trim(recv![Model_Folder]) & Trim(recv![Travel_Model_Name])
    checkup = Dir(Model, vbHidden)
    
    If checkup = "" Then
        checkup = MsgBox("Model file " & Model & " missing. Operation not possible", vbCritical, "Oops")
        GoTo exit_create_Travel
    End If
    
    ' instantiate the word application and create a new
    ' document based upon the supplied template
    Set m_objWord = New Word.Application
    m_objWord.Visible = True ' new 2011
    
    
    Set m_objdoc = m_objWord.Documents.Add(Model, , , True)
    
    ' insert the Student details
    m_objdoc.Bookmarks("Student_Name").Range.Text = Student_Name & ""
    m_objdoc.Bookmarks("Center").Range.Text = center & ""
    m_objdoc.Bookmarks("Arrival_Date").Range.Text = Date_From & ""
    m_objdoc.Bookmarks("Departure_Date").Range.Text = Date_To & ""
    m_objdoc.Bookmarks("reference").Range.Text = Reference & ""
    'Insert Filename in header
    m_objdoc.Bookmarks("Filename").Range.Text = Student_Name & "_Travel.DOC" & ""
    
    
    'Save File required before closing to prevent a window at exit
    doc = Trim(recv![Generated_Folder]) & Student_Name & "_Travel.DOC"
    
    fichier = Dir(doc, vbHidden)
    If fichier <> "" Then
        Kill doc
        DoEvents
    End If
   
    m_objdoc.SaveAs Filename:=doc
    DoEvents
    
    

        Select Case True
           Case pdf_flag
                m_objdoc.Application.Run ("Module1.Converttopdf_Silent")
                Pdfdoc = Trim(recv![Generated_Folder]) & Student_Name & "_Travel.PDF"
                NewPdfdoc = Trim(recv![Generated_Acrobat_Folder]) & Student_Name & "_Travel.PDF"
                FileCopy Pdfdoc, NewPdfdoc
                Kill Pdfdoc
                PhWnd = OpenProgram(NewPdfdoc, 0)
           Case word_flag
                'Activate Word and printpreview the created document
                m_objWord.Activate 'new 2011
                'Print Preview the document
                m_objdoc.PrintPreview
                 'Wait for printpreview window closed
                Do While m_objWord.PrintPreview = True
                Loop
          End Select

      
    'Close all words instances
     m_objdoc.ActiveWindow = False
    
    'On Error Resume Next
    m_objdoc.Close
    
    recv.Close
    Reci.Close
    
    'On Error Resume Next
    m_objWord.Quit

    Set m_objdoc = Nothing
    Set m_objWord = Nothing
    Set recv = Nothing
    Set Reci = Nothing
    
    
exit_create_Travel:
End Sub
__________________
(\ _ /) Cordialement G@dz
(='.'=)

(")-(") Vous avez des neurones. Sollicitez-les. . Si vous êtes aidé, pensez à Voter.
Godzestla est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité Cette discussion est résolue.
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 09h02.


 
 
 
 
Partenaires

Hébergement Web