Copier un formfields de nombreuses fois

**Megguido21** · 24/08/2018, 12h00

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
Tableau.Cell(21, 3).Range.FormFields.Add Range:=Tableau.Cell(21, 3).Range, Type:=wdFieldFormDropDown
    With Tableau.Cell(21, 3).Range.FormFields
        .Name = "ListeDéroulante1"
        .Enabled = True
        .HelpText = "La longueur des champs va de 1 à 17 charactères."
        .DropDown.ListEntries.Add Name:="1"
        .DropDown.ListEntries.Add Name:="2"
        .DropDown.ListEntries.Add Name:="3"
        .DropDown.ListEntries.Add Name:="4"
        .DropDown.ListEntries.Add Name:="5"
        .DropDown.ListEntries.Add Name:="6"
        .DropDown.ListEntries.Add Name:="7"
        .DropDown.ListEntries.Add Name:="8"
        .DropDown.ListEntries.Add Name:="9"
        .DropDown.ListEntries.Add Name:="10"
    End With

Hello les jeunes,

Je viens pour la première fois de commencer à coder en VBA pour Word.
J'aime pas du tout

).
J'aimerais définir des Formfields, 5 différents qu'on retrouve environ une dizaine de fois dans le fichier.
Mon dilemme se situe dans la copie des dropdown (pas de ce qui aura été entré par l'utilisateur).
Je ne sais pas comment rappeler un formfield déjà créé; je n'ai pas la syntaxe adéquate.
ATTENTION je ne demande pas qu'ils soient liés entre eux.

Partout je trouve comment copier les résultats (ça ne m'intéresse pas) mais pas le Formfield en lui-même.

Merci de votre aide.

Invité · 31/08/2018, 05h58

Envoyé par Megguido21

Bonjour,

Ci-dessous une solution à tester. La procédure CreerDesChampsListeDeroulante crée trois listes déroulantes : deux dans deux tableaux différents, un dans le dernier paragraphe. Les éléments composant les listes sont envoyés en paramètres dans la procédure qui crée le champ. On vérifie que le range ne contient pas une liste déroulante, on la détruit le cas échéant.

Le nom de la liste déroulante découle du nom du signet créé en même temps que la liste. On modifie le nom du signet une fois l'objet liste déroulante complètement terminé.

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
 
Option Explicit
 
Sub CreerDesChampsListeDeroulante()
 
Dim DocEnCours As Document
Dim MonRange As Range
Dim MaListe As Variant
 
        On Error GoTo Fin
 
        Set DocEnCours = ActiveDocument
 
        With DocEnCours
 
            MaListe = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
            Set MonRange = .Tables(1).Cell(21, 3).Range
            CreerUnFormFieldDropDown MonRange, "AAA", MaListe, "La longueur des champs va de 1 à 17 charactères."
            Set MonRange = Nothing
 
            MaListe = Array("A", "B", "C", "D")
            Set MonRange = .Tables(2).Cell(2, 1).Range
            CreerUnFormFieldDropDown MonRange, "BBB", MaListe, "XXXXXXXXXXXX"
            Set MonRange = Nothing
 
 
            MaListe = Array("Alpha", "Bravo", "Charlie", "Delta", "Echo")
            Set MonRange = .Paragraphs(.Paragraphs.Count).Range
            CreerUnFormFieldDropDown MonRange, "CCC", MaListe, "Aphabet NATO"
            Set MonRange = Nothing
 
 
        End With
 
        GoTo Fin
 
Fin:
 
    Set DocEnCours = Nothing
 
End Sub
 
 
Sub CreerUnFormFieldDropDown(ByVal MonRange2 As Range, ByVal MonNom2 As String, ByVal MaListe2 As Variant, ByVal MonTexteDAide2 As String)
 
Dim I As Integer
Dim MonFormField As FormField
 
    With MonRange2
 
         ' Suppression du formfield existant le cas échéant
        If .FormFields.Count > 0 Then
            For I = .FormFields.Count To 1 Step -1
                 .FormFields(I).Delete
            Next I
        End If
 
        ' Création du formfield
        .FormFields.Add Range:=MonRange2, Type:=wdFieldFormDropDown
 
         Set MonFormField = .FormFields(.FormFields.Count)
         With MonFormField
              .Enabled = True
              .OwnHelp = True
              .HelpText = MonTexteDAide2
              For I = LBound(MaListe2, 1) To UBound(MaListe2, 1)
                  .DropDown.ListEntries.Add Name:=MaListe2(I)
              Next I
        End With
 
        MonFormField.Name = MonNom2
        'Debug.Print MonFormField.Name
 
        Set MonFormField = Nothing
 
    End With
 
End Sub

**Megguido21** · 05/09/2018, 13h08

Merci pour ta réponse Éric.
J'ai retravaillé ce que tu m'as mis.
Cela me donne ce que j'ai mis plus bas.
Je me suis départi de la fonction, parce que moins il y a de code mieux je me porte.
Par contre c'est lent, dans tous les cas

.

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
 
Sub test2()
Dim i As Integer
Dim j As Integer
Dim MonFormField As FormField
 
 
            For i = 1 To 10
                With Tables(1).Cell(20 + i, 3).Range
 
                    .FormFields.Add Range:=Tables(1).Cell(20 + i, 3).Range, Type:=wdFieldFormDropDown
 
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        For j = 1 To 17
                        .DropDown.ListEntries.Add Name:=j
                        Next j
                    End With
                    MonFormField.Name = "AAA" & i
                    Set MonFormField = Nothing
 
                End With
 
            Next i
 
            For i = 1 To 10
                With Tables(1).Cell(20 + i, 4).Range
 
                    .FormFields.Add Range:=Tables(1).Cell(20 + i, 4).Range, Type:=wdFieldFormDropDown
 
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        .DropDown.ListEntries.Add Name:="Alphabétique"
                        .DropDown.ListEntries.Add Name:="Alphanumérique"
                        .DropDown.ListEntries.Add Name:="Numérique"
                    End With
                    MonFormField.Name = "BBB" & i
 
                    Set MonFormField = Nothing
 
                End With
 
            Next i
 
            For i = 1 To 10
                With Tables(1).Cell(20 + i, 5).Range
 
                    .FormFields.Add Range:=Tables(1).Cell(20 + i, 5).Range, Type:=wdFieldFormDropDown
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        .DropDown.ListEntries.Add Name:="Oui"
                        .DropDown.ListEntries.Add Name:="Non"
                    End With
                    MonFormField.Name = "BBB" & i
 
                    Set MonFormField = Nothing
 
                End With
 
            Next i
 
End Sub

Invité · 05/09/2018, 13h19

Envoyé par Megguido21

Bonjour,

Tu peux ajouter les deux lignes de code pour neutraliser la mise à jour de l'écran : Application.ScreenUpdating = False et Application.ScreenUpdating = True comme ci-dessous.

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
 
 
Sub test2()
Dim i As Integer
Dim j As Integer
Dim MonFormField As FormField
 
  Application.ScreenUpdating = False
 
 
            For i = 1 To 10
                With Tables(1).Cell(20 + i, 3).Range
 
                    .FormFields.Add Range:=Tables(1).Cell(20 + i, 3).Range, Type:=wdFieldFormDropDown
 
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        For j = 1 To 17
                        .DropDown.ListEntries.Add Name:=j
                        Next j
                    End With
                    MonFormField.Name = "AAA" & i
                    Set MonFormField = Nothing
 
                End With
 
            Next i
 
            For i = 1 To 10
                With Tables(1).Cell(20 + i, 4).Range
 
                    .FormFields.Add Range:=Tables(1).Cell(20 + i, 4).Range, Type:=wdFieldFormDropDown
 
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        .DropDown.ListEntries.Add Name:="Alphabétique"
                        .DropDown.ListEntries.Add Name:="Alphanumérique"
                        .DropDown.ListEntries.Add Name:="Numérique"
                    End With
                    MonFormField.Name = "BBB" & i
 
                    Set MonFormField = Nothing
 
                End With
 
            Next i
 
            For i = 1 To 10
                With Tables(1).Cell(20 + i, 5).Range
 
                    .FormFields.Add Range:=Tables(1).Cell(20 + i, 5).Range, Type:=wdFieldFormDropDown
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        .DropDown.ListEntries.Add Name:="Oui"
                        .DropDown.ListEntries.Add Name:="Non"
                    End With
                    MonFormField.Name = "BBB" & i
 
                    Set MonFormField = Nothing
 
                End With
 
            Next i
 
   Application.ScreenUpdating = True
 
End Sub

**Megguido21** · 05/09/2018, 16h13

Merci j'ai gagné une seconde

.
J'écrivais le code sur un portable doté d'un Atom X5-8350, quadcore qui turbo à 1,9 GHz.
Là je suis sur un i7-2600 qui turbo à 3,8 GHz. C'est pas la même histoire.
Mais je passe quand même de 5 secondes à 4 secondes.
Merci bien.
Je met en résolu.

Invité · 05/09/2018, 16h23

Envoyé par Megguido21

Tu peux aussi réduire ton nombre de boucles puisque I va de 1 à 10 à chaque fois. Ci-dessous, ton code modifié :

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
 
 
Sub test2()
Dim i As Integer
Dim j As Integer
Dim MonFormField As FormField
Dim MaTable As Table
 
  Application.ScreenUpdating = False
 
     Set MaTable = ActiveDocument.Tables(1)
     With MaTable
 
            For i = 1 To 10
 
                With .Cell(20 + i, 3).Range
 
 
                    If .FormFields.Count > 0 Then
                      For j = .FormFields.Count To 1 Step -1
                          .FormFields(j).Delete
                      Next j
                    End If
 
                    .FormFields.Add Range:=MaTable.Cell(20 + i, 3).Range, Type:=wdFieldFormDropDown
 
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        For j = 1 To 17
                        .DropDown.ListEntries.Add Name:=j
                        Next j
                    End With
                    MonFormField.Name = "AAA" & i
                    Set MonFormField = Nothing
 
                End With
 
                With .Cell(20 + i, 4).Range
 
                    If .FormFields.Count > 0 Then
                      For j = .FormFields.Count To 1 Step -1
                          .FormFields(j).Delete
                      Next j
                    End If
 
                    .FormFields.Add Range:=MaTable.Cell(20 + i, 4).Range, Type:=wdFieldFormDropDown
 
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        .DropDown.ListEntries.Add Name:="Alphabétique"
                        .DropDown.ListEntries.Add Name:="Alphanumérique"
                        .DropDown.ListEntries.Add Name:="Numérique"
                    End With
                    MonFormField.Name = "BBB" & i
 
                    Set MonFormField = Nothing
 
                End With
 
                With .Cell(20 + i, 5).Range
 
                    If .FormFields.Count > 0 Then
                      For j = .FormFields.Count To 1 Step -1
                          .FormFields(j).Delete
                      Next j
                    End If
 
                    .FormFields.Add Range:=MaTable.Cell(20 + i, 5).Range, Type:=wdFieldFormDropDown
                    Set MonFormField = .FormFields(.FormFields.Count)
                    With MonFormField
                        .DropDown.ListEntries.Add Name:="Oui"
                        .DropDown.ListEntries.Add Name:="Non"
                    End With
                    MonFormField.Name = "BBB" & i
 
                    Set MonFormField = Nothing
 
                End With
 
            Next i
 
     End With
 
       Set MaTable = Nothing
   Application.ScreenUpdating = True
 
End Sub

Copier un formfields de nombreuses fois

VBA Word

Discussions similaires

Partager

Partager