Discussion :

[tomy7]

bonjour,
j utilise ce code pour remplir des docs word depuis excel mais ce la ouvre le doc.

Code :

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

1
2
3
4
5
6
7
8
Dim apdoc as variant
Dim appword as variant
set appword = New Word.application
Do events
set appdoc= appwor.documents.open(filename:="D:\......)
Application.displayalerts = true
appword.showme
appword.visible = true

mais j aimerai le remplir (avec des bookmarks)sans qui s ouvre ?

et faire de meme pour un doc excel ce que je n ai jamais fais?


merci

[ouskel'n'or]

Remplace appword.visible = true par appword.visible = False, tu ne le verras pas.
Ensuite, tu travailles dedans et tu le fermes à la fin

Code :

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

appword.close True 'true pour l'enregistrer

[tomy7]

tu connais la technique?

[ouskel'n'or]

La technique pour ? Ecrire dans Excel depuis Word ?
Si c'est ça, la solution a été donnée dans le forum VBA-Word ces jours-ci, tu la retrouveras sûrement.

Edit
Regarde là http://www.developpez.net/forums/sho...d.php?t=498255

[tomy7]

non la technique pour appeler un doc excel de la meme maniere que je fais pour le doc word?

[ouskel'n'or]

C'est pareil. Sauf que tu mets New Excel.application au lieu de Word.Application
Attention, cette manière de procéder t'ouvre une nouvelle instance d'Excel qu'il te faudra refermer.

[tomy7]

ok merci je v tester sa....je pense que je donnerai ma rep la semaine prochaine ....


merci ouskel 'nor , tjrs aussi fort.

la rime n est pas voulu...

[tomy7]

j 'ai mon private sub button_OK_click ()

debut de mon sub

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
    Select Case True
    Case combobox2 = "A" And Sheet2.PC_F_03_A
        PCF3 = "D:\Documents and Settings\be30enginering\My Documents\structure\template A\"
    Case combobox2 = "B" And Sheet2.PC_F_03_B
        PCF3 = "D:\Documents and Settings\be30enginering\My Documents\structure\template B\"
    Case combobox2 = "C" And Sheet2.PC_F_03_C
        PCF3 = "D:\Documents and Settings\be30enginering\My Documents\structure\template C\"
    Case combobox2 = "D" And Sheet2.PC_F_03_D
        PCF3 = "D:\Documents and Settings\be30enginering\My Documents\structure\template D\"
    End Select
 
    MkDir PCF3
    fs.CopyFile "D:\Documents and Settings\be30enginering\My Documents\shared\nini*.*", PCF3 & "\"
 
 
    Select Case True
    Case combobox2 = "A" And Sheet2.PC_F_04_A
        PCF4 = "D:\Documents and Settings\be30enginering\My Documents\structure\template A\"
    Case combobox2 = "B" And Sheet2.PC_F_04_B
        PCF4 = "D:\Documents and Settings\be30enginering\My Documents\structure\template B\"
    Case combobox2 = "C" And Sheet2.PC_F_04_C
        PCF4 = "D:\Documents and Settings\be30enginering\My Documents\structure\template C\"
    Case combobox2 = "D" And Sheet2.PC_F_04_D
        PCF4 = "D:\Documents and Settings\be30enginering\My Documents\structure\template D\"
    End Select
    MkDir PCF4
    fs.CopyFile "D:\Documents and Settings\be30enginering\My Documents\shared\nana*.*", PCF4 & "\"
 
.ici plein de select case
.
.
.
.fin de mon sub 
 
 Dim appdoc As Variant
    Dim appword As Variant
    Set appword = New Word.Application
    DoEvents
    Set appdoc = appword.Documents.Open(Filename:=PCF4 & "\nana*.*")
    Application.DisplayAlerts = True
    appword.ShowMe
    appword.Visible = False
    appdoc.Bookmarks("ProjectNumber").Range.Text = Textbox1.Value
    appdoc.Bookmarks("ProjectManager").Range.Text = combobox1.Value
    appdoc.Bookmarks("CustomerName").Range.Text = TextBox2.Value
    appword.Close True
 
 
 Dim appxl As Variant
    Dim appexcel As Variant
    Set appexcel = New Excel.Application
    DoEvents
    Set appxl = appexcel.Documents.Open(Filename:=PCF4 & "\nini*.*")
    Application.DisplayAlerts = True
    appexcel.ShowMe
    appexcel.Visible = False
    appxl.Worksheets("Questions").Range("C3").Value = TextBox2.Value
    appxl.Worksheets("Questions").Range("C7").Value = Textbox1.Value
    appxl.Worksheets("Questions").Range("C5").Value = combobox1.Value
    appxl.Worksheets("Questions").Range("C4").Value = TextBox6.Value
    appxl.Worksheets("Questions").Range("C6").Value = TextBox3.Value
    appexcel.Close True

et j ai l erreur que j ai mis en piece jointe.Pièce jointe 26451

merci



Edit : je clic sur debug et j ai cette ligne en jaune.

Code :

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

Set appdoc = appword.Documents.Open(Filename:=PCF4 & "\nini*.*")

[ouskel'n'or]

On ne peut pas utiliser *.* comme en dos pour dir, pour ouvrir tous les fichier d'un répertoire. pour ça tu dois faire une boucle sur les noms de fichiers.
Tu as plusieurs méthodes, en voici une

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub OuvrirTsClasseursDunRépertoire(Chemin as string)
Dim fso As New FileSystemObject
Dim Fich As File
Dim Rep As Folder
Dim Wk As Variant
    Set Rep = fso.GetFolder(Chemin)
    For Each Fich In Rep.Files
        Wk = Chemin & Fich.Name
        'Ouvrir les fichiers du répertoire
        If fso.GetExtensionName(Wk) = "xls" Then _
           Workbooks.Open Wk
    Next
    Set Rep = Nothing
End Sub

Tu appelles cette procédure avec le chemin de tes fichiers

Code :

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

OuvrirTsClasseursDunRépertoire Chemin

ou une autre solution

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub TableauNomsFichiers()
Dim cheminRep, NomFich() As Variant
cheminRep = "D:\Doc\"
On Error Resume Next
    NomLu = Dir(cheminRep, vbNormal)
    If Err = 5 Then Exit Sub
    Do While NomLu <> ""
        Workbooks.Open Chemin + NomLu
        DoEvents
        NomLu = Dir
    Loop
On Error GoTo 0
End Sub

Me demande pas l'intérêt de l'un sur l'autre
Bonne journée

[tomy7]

je teste sa aujourd'hui ou demain , j ai un autre prob a resoudre avant... que je viens de voir...



merci comme d ab tu me depannes a fond...

[tomy7]

en faite je veux pas ouvrir tous les fichier justes, donc si je change *.* en .doc et .xls
sa devrai marché mais sa ne marche pas...

es tu d'accord ?

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
Dim appdoc As Variant
    Dim appword As Variant
    Set appword = New Word.Application
    DoEvents
    Set appdoc = appword.Documents.Open(Filename:=PCF4 & "\nana.doc")
    Application.DisplayAlerts = True
    appword.ShowMe
    appword.Visible = False
    appdoc.Bookmarks("ProjectNumber").Range.Text = Textbox1.Value
    appdoc.Bookmarks("ProjectManager").Range.Text = combobox1.Value
    appdoc.Bookmarks("CustomerName").Range.Text = TextBox2.Value
    appword.Close True
 
 
 Dim appxl As Variant
    Dim appexcel As Variant
    Set appexcel = New Excel.Application
    DoEvents
    Set appxl = appexcel.Documents.Open(Filename:=PCF4 & "\nini.xls)
    Application.DisplayAlerts = True
    appexcel.ShowMe
    appexcel.Visible = False
    appxl.Worksheets("Questions").Range("C3").Value = TextBox2.Value
    appxl.Worksheets("Questions").Range("C7").Value = Textbox1.Value
    appxl.Worksheets("Questions").Range("C5").Value = combobox1.Value
    appxl.Worksheets("Questions").Range("C4").Value = TextBox6.Value
    appxl.Worksheets("Questions").Range("C6").Value = TextBox3.Value
    appexcel.Close

[ouskel'n'or]

Je t'ai mis la solution, il ne restait qu'à l'adapter. Tu ne peux pas de cette manière ouvrir tous les .doc de ton répertoire.
Remplace

If fso.GetExtensionName(Wk) = "xls" Then _
Workbooks.Open Wk

par

Code :

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

1
2
        If fso.GetExtensionName(Wk) = "doc" Then _
        appword.Document.Open Wk

[tomy7]

j ai le message d erreur user defined type not defined

probleme de reference a ton avis ... pourtant j en ai deja bcp de cochee.

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
private sub button_ok ()
..
.
.
..
label112:

    Dim fso As New FileSystemObject
    Dim Fich As File
    Dim ans As Folder
    Dim wk As Variant
    Set ans = fso.GetFolder(chemin)
    For Each Fich In ans.Files
        wk = chemin & Fich.Name
        If fso.GetExtensionName(wk) = "doc" Then _
           appword.Document.Open wk
    Next
    Set ans = Nothing

    appword.Documents.Open (Filename = PCF4 & "\Tool 10-7 Change Control Notice.doc")
    Bookmarks("ProjectNumber").Range.Text = Textbox1.Value
    Bookmarks("ProjectManager").Range.Text = combobox1.Value
    Bookmarks("CustomerName").Range.Text = TextBox2.Value

    Dim fso As New FileSystemObject
    Dim Fich As File
    Dim ans As Folder
    Dim wk As Variant
    Set ans = fso.GetFolder(chemin)
    For Each Fich In ans.Files
        wk = chemin & Fich.Name
        If fso.GetExtensionName(wk) = "xls" Then _
           Workbooks.Open wk
    Next
    Set ans = Nothing

    Workbooks.Open (Filename = PCF3 & "\Tool 10-8 Change Order Approval Checklist.xls")
    Worksheets("Questions").Range("C3").Value = TextBox2.Value
    Worksheets("Questions").Range("C7").Value = Textbox1.Value
    Worksheets("Questions").Range("C5").Value = combobox1.Value
    Worksheets("Questions").Range("C4").Value = TextBox6.Value
    Worksheets("Questions").Range("C6").Value = TextBox3.Value

end sub

il bug sur dim fso as New FileSystemObject

tu as une idee?

[ouskel'n'or]

Oui, c'est l'inconvénient de passer par fso. Tu dois activer la référence "Microsoft Scripting RunTime" Pour ça, tu vas dans l'Editeur VBA -> Outils -> Références
A+

[tomy7]

probleme sur set ans = fso.GetFolder (chemin)

je dois surement mal appliquer le 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
private sub button_OK()
tous les Dim ici
.
.
.
.
.
 Set ans = fso.GetFolder(chemin)
    For Each Fich In ans.Files
        wk = chemin & Fich.Name
        If fso.GetExtensionName(wk) = "xls" Then _
           Workbooks.Open wk
        If fso.GetExtensionName(wk) = "doc" Then _
           appword.Document.Open wk
 
        appword.Document.Open (Filename = PCF4 & "\Tool 10-7 Change Control Notice")
        appword.Document.Bookmarks("ProjectNumber").Range.Text = Textbox1.Value
        appword.Document.Bookmarks("ProjectManager").Range.Text = combobox1.Value
        appword.Document.Bookmarks("CustomerName").Range.Text = TextBox2.Value
 
        Workbooks.Open (Filename = PCF3 & "\Tool 10-8 Change Order Approval Checklist")
        Worksheets("Questions").Range("C3").Value = TextBox2.Value
        Worksheets("Questions").Range("C7").Value = Textbox1.Value
        Worksheets("Questions").Range("C5").Value = combobox1.Value
        Worksheets("Questions").Range("C4").Value = TextBox6.Value
        Worksheets("Questions").Range("C6").Value = TextBox3.Value
    Next
    Set ans = Nothing

je pense que sa vient de chemin, enfin je sais pas trop...

[ouskel'n'or]

Tu as quoi dans chemin ? Chais pas s'il faut un \ à la fin ou non... Tu testes avec et sans...
A+

[tomy7]

je comprends bien que chemin = "D:\My Documents\tom\bibi\titi\"

mais j ai une centaine de document soit word soit excel à remplir depuis mon outils a laide de userform je recupère des info de textobx et combobox et je veux placer ces infos ds une centaine de documents.


et le chemin change ! dsl je pense que je m'étais mal exprimé.

donc est ce que ta methode est adaptable?




merci

[cafeine]

chemin est une variable, donc oui ! c'est adaptable.

je pense que tu devrais utiliser plus souvent les outils de débogage

• debug.print
• msgbox
• espions
• points d'arrêt dans le code

pour visualiser le contenu de tes variables.

[tomy7]

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
Private Sub Button_OK_Click()

Dim fso As New FileSystemObject
    Dim Fich As File
    Dim ans As Folder
    Dim wk As Variant
    Dim way As String

   ' tool 10.8
label41:     Select Case True
    Case combobox2 = "A" And Sheet2.PC_F_03_A
        PCF3 = "D:\Documents and Settings\My Documents\structure\template A\2.0 Project Management\2.4 Project Controls and Financial\2.4.03 Change Control Notices"
    Case combobox2 = "B" And Sheet2.PC_F_03_B
        PCF3 = "D:\Documents and Settings\My Documents\structure\template B\2.0 Project Management\2.4 Project Controls and Financial\2.4.03 Change Control Notices"
    Case combobox2 = "C" And Sheet2.PC_F_03_C
        PCF3 = "D:\Documents and Settings\My Documents\structure\template C\2.0 Project Management\2.4 Project Controls and Financial\2.4.03 Change Control Notices"
    Case combobox2 = "D" And Sheet2.PC_F_03_D
        PCF3 = "D:\Documents and Settings\My Documents\structure\template D\2.0 Project Management\2.4 Project Controls and Financial\2.4.03 Change Control Notices"
    Case Else: GoTo label42
    End Select
    MkDir PCF3
    fso.CopyFile "D:\Documents and Settings\be30enginering\My Documents\shared\Tool 10-8 Change Order Approval Checklist*.*", PCF3 & "\"

    'tool 10.7
label42:     Select Case True
    Case combobox2 = "A" And Sheet2.PC_F_04_A
        PCF4 = "D:\Documents and Settings\be30enginering\My Documents\structure\template A\2.0 Project Management\2.4 Project Controls and Financial\2.4.04 Billings Request, Invoices and Credit Notes"
    Case combobox2 = "B" And Sheet2.PC_F_04_B
        PCF4 = "D:\Documents and Settings\My Documents\structure\template B\2.0 Project Management\2.4 Project Controls and Financial\2.4.04 Billings Request, Invoices and Credit Notes"
    Case combobox2 = "C" And Sheet2.PC_F_04_C
        PCF4 = "D:\Documents and Settings\My Documents\structure\template C\2.0 Project Management\2.4 Project Controls and Financial\2.4.04 Billings Request, Invoices and Credit Notes"
    Case combobox2 = "D" And Sheet2.PC_F_04_D
        PCF4 = "D:\Documents and Settings\My Documents\structure\template D\2.0 Project Management\2.4 Project Controls and Financial\2.4.04 Billings Request, Invoices and Credit Notes"
    Case Else: GoTo label43
    End Select
    MkDir PCF4
    fso.CopyFile "D:\Documents and Settings\be30enginering\My Documents\shared\Tool 10-7 Change Control Notice*.*", PCF4 & "\"

label111:
    way = PCF4 & "\"
    Set ans = fso.GetFolder(way)    

For Each Fich In ans.Files
        wk = way & Fich.Name

        If fso.GetExtensionName(wk) = "doc" Then _
           appword.Document.Open wk
        appword.Document.Bookmarks("ProjectNumber").Range.Text = Textbox1.Value
        appword.Document.Bookmarks("ProjectManager").Range.Text = combobox1.Value
        appword.Document.Bookmarks("CustomerName").Range.Text = TextBox2.Value
        way = PCF3 & "\"
        wk = way & Fich.Name
        Set ans = fso.GetFolder(way)
        If fso.GetExtensionName(wk) = "xls" Then _
           Workbooks.Open wk
        Worksheets("Questions").Range("C3").Value = TextBox2.Value
        Worksheets("Questions").Range("C7").Value = Textbox1.Value
        Worksheets("Questions").Range("C5").Value = combobox1.Value
        Worksheets("Questions").Range("C4").Value = TextBox6.Value
        Worksheets("Questions").Range("C6").Value = TextBox3.Value
    Next
    Set ans = Nothing

    Select Case True
    Case combobox2 = "A"
        fso.movefolder "D:\Documents and Settings\My Documents\structure\template A\*", New_project
    Case combobox2 = "B"
        fso.movefolder "D:\Documents and Settings\My Documents\structure\template B\*", New_project
    Case combobox2 = "C"
        fso.movefolder "D:\Documents and Settings\My Documents\structure\template C\*", New_project
    Case combobox2 = "D"
        fso.movefolder "D:\Documents and Settings\My Documents\structure\template D\*", New_project
    End Select
    Set fso = Nothing

    Unload UserForm1
    UserForm2.Show

End Sub

prob sur set ans !!!
une idée j ai essayé avec / ou sans /

mais cela ne vient pas de la apparemment

[cafeine]

Aucun code ne vérifie l'existence du répertoire créé par MkDir
l'inexistence lève l'erreur 76 en principe.