Discussion :

[enretard]

bonjour,

j'ai un problème, je voudrais remplir un document word avec un formulaire (userform). Je m'explique :

Tout d'abord, j'ai un classeur Excel avec 3 feuilles.
J'ai un document word avec quelques signets

J'ai créer un formulaire (userform) avec 2 Listboxs et différents texboxs.

Dans ma première Listbox1 "nom société" (je voudrais ma plage de cellules de la feuille 1 qui contient les noms des sociétés)
Dans ma deuxième Listbox2 "destinataire"(je voudrais qu'elle soit liée à listbox1)

C'est-à-dire que Listbox2 change en même temps que la Listbox1.

Et qu'ensuite les différents signets placés sur mon doc word se remplissent.

Je vous envoie 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
149
150
151
Option Explicit
 
Private Sub Effacer_Click()
reponse = MsgBox("Voulez-vous vraiment quitter ?", vbYesNo, "QUITTER")
If vbYesNo = oui Then
Range("tbxclient").Clear
Range("tbxcontrat").Clear
Range("tbxlieu").Clear
Range("tbxmoyendepaiement").Clear
Range("tbxprix").Clear
Unload userform1
Else
End If
End Sub
 
Private Sub ListBox1_Change()
Dim str As String, cel As Range
 
str = ListBox1.Value
With Worksheets("contrats")
For Each cel In .Range("H2:H" & .Range("h" & Rows.Count).End(xlUp).Row)
    If cel = str Then
        With ListBox2
        .AddItem cel(1, 6)
        End With
    End If
    Next cel
    End With
 
End Sub
 
Private Sub ListBox1_Click()
Dim str As String, cel As Range
ListBox2.Clear
 
str = ListBox1.Value
With Worksheets("contacts")
For Each cel In .Range("H2:H" & .Range("H" & Rows.Count).End(xlUp).Row)
If cel = str Then
With ListBox2
AddItem cel(1, 2)
 
End With
End If
Next cel
End With
 
End Sub
 
Private Sub ListBox2_Change()
Dim str As String, cel As Range
tbxprix.Clear
str = ListBox2.Value
With Worksheets("contrats")
For Each cel In .Range("H2:H" & .Range("H" & Rows.Count).End(xlUp).Row)
If cel = str Then
With tbxprix
    AddItem cel(1, 2)
    End With
    End If
    Next cel
    End With
End Sub
 
Private Sub OK_Click()
ListBox1.SetFocus
If ListBox1 = "" Or tbxclient = "" Or tbxcontrat = "" Or tbxprix = "" Or tbxmoyendepaiement = "" Or tbxlieu = "" Then
reponse = MsgBox("vous n'avez pas remplis certaines informations!", vbCritical, "ATTENTION")
ligne = Cells(Rows.Count, "H").End(xlUp).Row
 
Range("H" & ligne) = ListBox1
Range("A" & ligne) = tbxcontrat
Range("E" & ligne) = tbxproduit
Range("G" & ligne) = tbxclient
Range("J" & ligne) = tbxdestinataire
Range("N" & ligne) = tbxprix
Range("K" & ligne) = tbxlieu
Range("E" & ligne) = tbxmoyendepaiement
End If
 
userform1.Hide
End Sub
 
Private Sub tbxclient_Change()
If Not IsNumeric(tbxclient) Then
reponse = MsgBox("veuillez indiquer un nombre SVP", , "ATTENTION")
tbxclient = Clear
End If
End Sub
 
Private Sub tbxcontrat_Change()
If Not IsNumeric(tbxcontrat) Then
reponse = MsgBox("veuillez indiquer un nombre", vbCritical, "ERREUR")
tbxcontrat = Clear
End If
End Sub
 
 
Private Sub tbxdestinataire_Change()
If Not IsNumeric(tbxlieu) Then
reponse = MsgBox("veuillez écrire du texte SVP", , "ATTENTION")
tbxdestinataire = Clear
End If
End Sub
 
Private Sub tbxlieu_Change()
If Not IsNumeric(tbxlieu) Then
reponse = MsgBox("veuillez écrire du texte SVP", , "ATTENTION")
tbxlieu = Clear
End If
End Sub
 
Private Sub tbxmoyendepaiement_Change()
If IsNumeric(tbxmoyendepaiement) Then
reponse = MsgBox("veuillez écrire un nom de societe SVP", , "ATTENTION")
tbxmoyendepaiement = Clear
End If
End Sub
 
Private Sub tbxprix_Change()
If Not IsNumeric(tbxprix) Then
reponse = MsgBox("veuillez indiquer un chiffre SVP", , "ATTENTION")
tbxprix = Clear
End If
End Sub
 
Private Sub tbxproduit_Change()
If Not IsNumeric(tbxproduit) Then
reponse = MsgBox("Merci de ne mettre que les initiales ex: FINES")
tbxproduit = Clear
End If
End Sub
 
Private Sub UserForm1_Activate()
Worksheets("contacts").Activate
Worksheets("clients").Activate
userform1!ListBox1.SetFocus
End Sub
 
Private Sub UserForm_Initialize()
Dim contrats As String
Dim clients As String
Dim y As String
 
Sheets("contrats").Activate
Sheets("clients").Activate
y = Sheets("clients").Range("E2").End(xlDown).Offset(0, 4).Row
y = Sheets("contrats").Range("H2").End(xlDown).Offset(0, 7).Row
ListBox1.RowSource = "H2:H" & y
 
End Sub

Quelqu'un à t'il une idée ?

Merci c'est très urgent.

Je vous joints mon fichier projet entier en image pour que vous compreniez mieux.

Merci à tous.

[ouskel'n'or]

Je ne vois pas la macro effectuant cette copie
Pour travailler dans un document word, regarde déjà ici pour ce qui concerne l'ouverture et la fermeture.
Pour coller sur un signet, tu as le code dans le forum word. Il suffit que tu le fasse précéder de l'objet application (AppWd ou WdApp la plupart du temps)
Sinon, regarde à bookmarks, dans l'aide Word, enregistre une macro en faisant dans word et si tu n'arrives pas à adapter, on t'aidera
Bon courage
A+

[enretard]

bonsoir,

Peux-tu m'envoyer le lien, car je n'ai pas trouvé l'exemple concernant word ?

Merci à toi pour avoir répondu.

A+

[ouskel'n'or]

Désolé, j'ai cru l'avoir mis http://www.developpez.net/forums/sho...highlight=word

[enretard]

bonjour,

Merci beaucoup pour l'aide de word, je suppose qu'il faut écrire le code VBA dans Excel ?

Je ne vois pas la macro effectuant cette copie

La macro se trouve dans le premier message

Bon j'essaye le code modèle et je vous dis où j'en suis après.

Merci

[ouskel'n'or]

Juste une remarque :
Tu pourrais avantageusement simplifier ton code en réunissant le contrôle de tes saisies dans une même procédure puisque tu as un bouton Ok qui semble valider les données.
En outre, dans le code de ce bouton, tu masques l'userform après avoir renseigné les lignes de ta feuille de calculs même si les champs ne sont pas tous remplis. Tu pourrais par exemple mettre ceci...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub OK_Click()
    If ListBox1 = "" Or tbxclient = "" Or tbxcontrat = "" Or tbxprix = "" _
                        Or tbxmoyendepaiement = "" Or tbxlieu = "" Then
         MsgBox "vous n'avez pas remplis certaines informations!", vbCritical, "ATTENTION"
         Listbox1.setFocus
         exit sub
    endif
    'la suite si tous les contrôles sont renseignés
    ligne = Cells(Rows.Count, "H").End(xlUp).Row
    '...
 
End Sub

Par ailleurs, dans tes vérifications, j'utiliserais l'événement exit plutôt que change

Code :

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

1
2
3
4
5
6
7
Private Sub tbxcontrat_Exit()
    If Not IsNumeric(tbxcontrat) Then
        reponse = MsgBox("Veuillez indiquer un nombre", vbCritical, "ERREUR")
        'tbxcontrat = Clear 'pas très utile, ne pas l'effacer permet de voir son erreur de saisie
        tbxcontrat.setFocus
    End If
End Sub

Enfin, à plusieurs reprises tu testes un numérique alors que ce doit être un texte. Corrige "If not..." par "If ..."

Code :

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

1
2
3
4
5
6
7
Private Sub tbxdestinataire_Exit()
    If IsNumeric(tbxdestinataire) Then
        reponse = MsgBox("Veuillez écrire du texte SVP", , "ATTENTION")
        'tbxdestinataire = Clear
        tbxdestinataire.setFocus
    End If
End Sub

Attention, dans ton code tu as mis

Private Sub tbxdestinataire_Change()
If Not IsNumeric(tbxlieu) Then

Bonne journée