[Signets et remplissage par UserForm] Les signets ne sont pas remplis

**GSchaffter** · 05/02/2015, 10h56

Bonjour à toutes et tous,

je suis nouveau sur le forum, mais je vous lis depuis un certain temps.

Je suis confronté à un problème qui me dépasse. Malgré avoir lu pratiquement tout ce que je trouve sur Internet au sujet des signets et des UserForm, je suis sans solution à ce jour.

Mon problème se situe dans un fichier modèle Word. Je désire que lorsqu'il est fait appel à ce modèle, le nouveau document créé sur cette base s'ouvre (ça marche, toujours) et qu'il affiche immédiatement un masque (UserForm; ça marche aussi) que l'utilisateur remplira avec les informations de base telles que Auteur (1 et/ou 2), Qualité de celui/ceux-ci, Objet, Date, Annexe(s) (s'il y en a) et Copie(s) à (s'il y en a), notamment. Le but est qu'au final l'utilisateur n'ait plus qu'à rédiger son message et entrer l'adresse (ou faire un publipostage). Ce modèle Word doit être distribué aux membres du comité directeur d'une association qui devrait ainsi tous utilisé le même format/mise en page de document.

Seulement voilà, tout marche sauf que les signets ne sont pas mis à jour (rempli avec les données du UserForm) et que le fichier n'est pas effectivement sauvegarder (une fois presser sur le bouton ad hoc du UserForm).

Saurez-vous m'aider ?

Voici le code rattaché au bouton en question :

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
 
Private Sub Button_Intro_Click()
 
 Application.ScreenUpdating = False
 
 'Coloration des Labels en noir / non gras
    LAuteur1.ForeColor = RGB(0, 0, 0)
    LAuteur1.Font.Bold = False
    LAuteur2.ForeColor = RGB(0, 0, 0)
    LAuteur2.Font.Bold = False
    LLieu.ForeColor = RGB(0, 0, 0)
    LLieu.Font.Bold = False
    LQualite1.ForeColor = RGB(0, 0, 0)
    LQualite1.Font.Bold = False
    LQualite2.ForeColor = RGB(0, 0, 0)
    LQualite2.Font.Bold = False
    LObjet.ForeColor = RGB(0, 0, 0)
    LObjet.Font.Bold = False
    LRef.ForeColor = RGB(0, 0, 0)
    LRef.Font.Bold = False
    F_Annexes.ForeColor = RGB(0, 0, 0)
    F_Annexes.Font.Bold = False
    F_Copies.ForeColor = RGB(0, 0, 0)
    F_Copies.Font.Bold = False
 
 
    'Contrôles de contenu
    If TB_Auteur2.Value <> "" Then 'contrôle de l'indication d'un 2e auteur et de sa qualité
        LQualite2.ForeColor = RGB(255, 0, 0)
        LQualite2.Font.Bold = True
        MsgBox "S'il y a un 2e auteur, alors sa qualité doit être mentionnée"
 
    ElseIf TB_Auteur1.Value = "" Then 'Nom et prénom de l'auteur 1 --> Si vide, alors
        LAuteur1.ForeColor = RGB(255, 0, 0) 'label en rouge
        LAuteur1.Font.Bold = True 'et gras
        LRem.ForeColor = RGB(255, 0, 0) 'Colore aussi la remarque en bas en rouge
        LRem.Font.Bold = True ' et gras
 
    ElseIf TB_Qualite1.Value = "" Then 'Qualité de l'auteur 1
        LQualite1.ForeColor = RGB(255, 0, 0)
        LQualite1.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf TB_Lieu.Value = "" Then 'Lieu
        LLieu.ForeColor = RGB(255, 0, 0)
        LLieu.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf TB_Objet.Value = "" Then 'Objet
        LObjet.ForeColor = RGB(255, 0, 0)
        LObjet.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf TB_Ref.Value = "" Then 'No de référence
        LRef.ForeColor = RGB(255, 0, 0)
        LRef.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf OB_Annexes_oui.Value Or OB_Annexes_non.Value = 0 Then 'Choix Annexes
        F_Annexes.ForeColor = RGB(255, 0, 0)
        F_Annexes.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf OB_Annexes_oui.Value = 1 And TB_Annexes.Value = "" Then
        MsgBox "S'il y a une ou des annexes, prière de la/les mentionner"
 
    ElseIf OB_Copies_oui.Value Or OB_Copies_non.Value = 0 Then 'Choix Copies
        F_Copies.ForeColor = RGB(255, 0, 0)
        F_Copies.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf OB_Copies_oui.Value = 1 And TB_Copies.Value = "" Then
        MsgBox "S'il y a une ou des copies à adresser, prière d'indiquer les destinataires"
 
    Else
    With ActiveDocument
    .Bookmarks("Lieu").Range.Text = UserForm1.TB_Lieu.Value
    .Bookmarks("Date").Range.Text = UserForm1.DTPicker1.Value
    .Bookmarks("Objet").Range.Text = UserForm1.TB_Objet.Value
    .Bookmarks("ref_AFS").Range.Text = UserForm1.TB_Ref.Value
    .Bookmarks("Auteur1").Range.Text = UserForm1.TB_Auteur1.Value
    .Bookmarks("Auteur2").Range.Text = UserForm1.TB_Auteur2.Value
    .Bookmarks("Qualite1").Range.Text = UserForm1.TB_Qualite1.Value
    .Bookmarks("Qualite2").Range.Text = UserForm1.TB_Qualite2.Value
    .Bookmarks("Annexes").Range.Text = UserForm1.TB_Annexes.Value
    .Bookmarks("copies_a").Range.Text = UserForm1.TB_Copies.Value
 
    End With
 
    End If
 
Application.ScreenUpdating = True
 
Unload Me 'ferme le masque
 
With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Sauvegarde du document AFS créé"
    .InitialFileName = Format(Date) & " - " & TB_Objet.Value & ".docx"
    .Show
End With
 
End Sub

Les contrôles quant au contenu des TextBox du UserForm ne sont pas tous au poil non plus, mais je peux vivre avec ... Quoique je suis preneur d'un bout de code qui me contrôle que si mes RadioButton sont sur "Oui" alors il faut que le TextBox qui est à côté soit non vide. J'ai essayé de le faire mais ça ne marche pas comme je veux (pas toute la logique n'est transposée en code).

Merci de votre aide

Gaël

**Heureux-oli** · 05/02/2015, 11h39

Salut,

Je pense que c'est ta structure If qui n'est pas bonne.

Tu devrais sortir le remplissage du document de cette structure décisionnelle.

**GSchaffter** · 05/02/2015, 12h05

Merci Heureux-oli,

Je sais que cette structure est longue, mais nécessaire pour le contrôle du contenu des cellules. Je ne peux pas vraiment y renoncer.

Entre temps, j'ai modifié mon code :

De ceci,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
 ...
Unload Me 'ferme le masque
 
With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Sauvegarde du document AFS créé"
    .InitialFileName = Format(Date) & " - " & TB_Objet.Value & ".docx"
    .Show
End With
 
End Sub

je suis passé à ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
 ... 
With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Sauvegarde du document AFS créé"
    .InitialFileName = Format(Date) & " - " & TB_Objet.Value & ".docx"
    .Show
End With
 
Unload Me 'ferme le masque
 
End Sub

Avec pour conséquence que les données du formulaire sont maintenant bien reprise dans le fichier.

Toutefois, malgré l'appel de la "boîte de dialogue de sauvegarder sous" et la reprise du champ "Objet" du formulaire dans le nom du fichier, il apparaît que le fichier n'est pas sauvegardé, même après avoir choisi un emplacement et pressé sur "enregistrer".

Quid ?

J'ai toujours besoin de votre aide.

Merci

Gaël

**Heureux-oli** · 05/02/2015, 12h15

Salut,

essaie après ton show de faire un execute.

**GSchaffter** · 05/02/2015, 12h28

Merci Heureux-oli,

La sauvegarde marche, mais maintenant les données du formulaires ne sont plus introduite dans le document.

Rhhaaa ... c'est à s'arracher les cheveux.

Mon but est lorsqu'un utilisateur utilise le modèle, à l'ouverture le masque de saisie d'affiche, il le remplisse aussi intégralement et logiquement que possible puis lorsqu'il a terminé clique sur un bouton qui va mettre les données du formulaire dans le document et lui proposer immédiatement après ça de sauvegarder le document sous un nom prédéfini (aaaa.mm.jj - [objet de la lettre].docx).

Quid du code actuel ?

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
 
Private Sub Button_Intro_Click()
 
 Application.ScreenUpdating = False
 
 'Coloration des Labels en noir / non gras
    LAuteur1.ForeColor = RGB(0, 0, 0)
    LAuteur1.Font.Bold = False
    LAuteur2.ForeColor = RGB(0, 0, 0)
    LAuteur2.Font.Bold = False
    LLieu.ForeColor = RGB(0, 0, 0)
    LLieu.Font.Bold = False
    LQualite1.ForeColor = RGB(0, 0, 0)
    LQualite1.Font.Bold = False
    LQualite2.ForeColor = RGB(0, 0, 0)
    LQualite2.Font.Bold = False
    LObjet.ForeColor = RGB(0, 0, 0)
    LObjet.Font.Bold = False
    LRef.ForeColor = RGB(0, 0, 0)
    LRef.Font.Bold = False
    F_Annexes.ForeColor = RGB(0, 0, 0)
    F_Annexes.Font.Bold = False
    F_Copies.ForeColor = RGB(0, 0, 0)
    F_Copies.Font.Bold = False
 
 
    'Contrôles de contenu
    If TB_Auteur2.Value <> "" Then 'contrôle de l'indication d'un 2e auteur et de sa qualité
        LQualite2.ForeColor = RGB(255, 0, 0)
        LQualite2.Font.Bold = True
        MsgBox "S'il y a un 2e auteur, alors sa qualité doit être mentionnée"
 
    ElseIf TB_Auteur1.Value = "" Then 'Nom et prénom de l'auteur 1 --> Si vide, alors
        LAuteur1.ForeColor = RGB(255, 0, 0) 'label en rouge
        LAuteur1.Font.Bold = True 'et gras
        LRem.ForeColor = RGB(255, 0, 0) 'Colore aussi la remarque en bas en rouge
        LRem.Font.Bold = True ' et gras
 
    ElseIf TB_Qualite1.Value = "" Then 'Qualité de l'auteur 1
        LQualite1.ForeColor = RGB(255, 0, 0)
        LQualite1.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf TB_Lieu.Value = "" Then 'Lieu
        LLieu.ForeColor = RGB(255, 0, 0)
        LLieu.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf TB_Objet.Value = "" Then 'Objet
        LObjet.ForeColor = RGB(255, 0, 0)
        LObjet.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf TB_Ref.Value = "" Then 'No de référence
        LRef.ForeColor = RGB(255, 0, 0)
        LRef.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf OB_Annexes_oui.Value Or OB_Annexes_non.Value = 0 Then 'Choix Annexes
        F_Annexes.ForeColor = RGB(255, 0, 0)
        F_Annexes.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf OB_Annexes_oui.Value = 1 And TB_Annexes.Value = "" Then
        MsgBox "S'il y a une ou des annexes, prière de la/les mentionner"
 
    ElseIf OB_Copies_oui.Value Or OB_Copies_non.Value = 0 Then 'Choix Copies
        F_Copies.ForeColor = RGB(255, 0, 0)
        F_Copies.Font.Bold = True
        LRem.ForeColor = RGB(255, 0, 0)
        LRem.Font.Bold = True
 
    ElseIf OB_Copies_oui.Value = 1 And TB_Copies.Value = "" Then
        MsgBox "S'il y a une ou des copies à adresser, prière d'indiquer les destinataires"
 
    Else
    With ActiveDocument
    .Bookmarks("Lieu").Range.Text = UserForm1.TB_Lieu.Value
    .Bookmarks("Date").Range.Text = UserForm1.DTPicker1.Value
    .Bookmarks("Objet").Range.Text = UserForm1.TB_Objet.Value
    .Bookmarks("ref_AFS").Range.Text = UserForm1.TB_Ref.Value
    .Bookmarks("Auteur1").Range.Text = UserForm1.TB_Auteur1.Value
    .Bookmarks("Auteur2").Range.Text = UserForm1.TB_Auteur2.Value
    .Bookmarks("Qualite1").Range.Text = UserForm1.TB_Qualite1.Value
    .Bookmarks("Qualite2").Range.Text = UserForm1.TB_Qualite2.Value
    .Bookmarks("Annexes").Range.Text = UserForm1.TB_Annexes.Value
    .Bookmarks("copies_a").Range.Text = UserForm1.TB_Copies.Value
 
    End With
 
    End If
 
Application.ScreenUpdating = True
 
With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Sauvegarde du document AFS créé"
    .InitialFileName = Format(Date) & " - " & TB_Objet.Value & ".docx"
    .Show
    .Execute
End With
 
Unload Me 'ferme le masque
 
End Sub

Merci de votre aide.

Gaël

**Heureux-oli** · 05/02/2015, 13h28

Salut,

Je pense que tes données ne sont plus introduites à cause de ta structure IF.
La méthode que j'utilise dans ce cas est un test pour chaque TextBox et si le test est False, je fais un SetFocus sur le TextBox, un message et une sortie de procédure.

[Signets et remplissage par UserForm] Les signets ne sont pas remplis

VBA Word

Vue hybride

Discussions similaires

Partager

Partager