Déplacement d'un bouton dans un modèle Word

**nd34d** · 30/08/2011, 10h45

Bonjour,
Je sélectionne la ligne qui contient un bouton (inlineshape) suivi de texte,
je coupe la sélection (.cut),
je descends de quelques lignes,
je colle ma sélection (.paste).
Tout se passe bien apparemment sauf que le bouton a changé de nom !?
Le nom du bouton est incrémenté !? ex: BtnTest10 -> BtnTest101
Ce qui est gênant quand on essaie d'y faire référence et notamment son code.
Y-aurait-il quelque chose à faire pour cela ?
Quand je tente de renommer le bouton, j'ai une erreur 'La commande 'Name' de l'objet x a échoué...'
Il y a un bouton par ligne et le but est de les trier.
Les captions des boutons sont en fait des compteurs dynamiques alignés sur les textes qui les suivent (chaque ligne commence par un signet qui me permet de me repérer) :
Quand le bouton est à zéro, il récupère la plus haute valeurs des autres boutons auquel il ajoute 1 et se l'attribue.
Quand la bouton est > zéro, il prend la valeur zéro et décrémente tous les autres de 1.
Quand on a fini, on élimine tous les boutons à zéro et on trie les boutons par valeur du bouton.
Quand on revient, on trie les boutons par ordre initial et on ajoute les boutons zéros manquants.
Tout se passe bien 1 fois sur 4 (en moyenne) : on dirait que VB garde le nom du bouton quelque part au moment du selection.cut, du coup ,au moment du selection.paste, il en crée un nouveau.
J'ai fait une fonction qui balaie et corrige ce défaut éventuel en fin de tri mais le Selection.InlineShapes(1).OLEFormat.Object.Name = sNomBtn échoue avec l'erreur VB.
Pourquoi cela ne fonctionne-t-il pas à chaque fois ?
La référence au nom du bouton est importante à cause du code lié au bouton.

Au départ :
(btn1:0) texte A
(btn2:0) texte B
(btn3:0) texte C
(btn4:0) texte D

En fin de choix :
(btn1:2) texte A
(btn2:3) texte B
(btn3:0) texte C
(btn4:1) texte D

Disposition finale :
(btn4:1) texte D
(btn1:2) texte A
(btn2:3) texte B

Quand on revient sur les choix :
(btn1:2) texte A
(btn2:3) texte B
(btn3:0) texte C
(btn4:1) texte D
Merci pour vos conseils.

**Heureux-oli** · 30/08/2011, 11h42

Salut,

Je ne parviens pas à reproduire ton problème, mon bouton ne change pas de nom.
Si tu pouvais nous en dire plus ?

**nd34d** · 30/08/2011, 17h41

j'ai essayé d'isoler le pb avec le code suivant :
Il faut ouvrir un doc vierge, coller tout le code, lancer 'F_Init' pour configurer le test puis jouer avec les boutons.

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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
Private Const GNbBtn As Integer = 10
'--- on travaille sur 10 boutons, on peut en ajouter x mais il faut ajouter x code btnPTC_Rang_x_Click()
 
'---------------------------------------------
Sub F_Init()
'---------------------------------------------
'--- init génral :
'---    - on supprime tout
'---    - on crée la table
'---    - on crée le bouton 'Fini'
'---    - on crée le signet zéro
'---------------------------------------------
'--- on supprime tout
Selection.WholeStory
Selection.Cut
'--- on crée la table
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:=2 _
    , DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
 
'--- on crée le bouton 'Fini'
Selection.Tables(1).Cell(1, 1).Select
Selection.TypeText vbCrLf
Me.Bookmarks.Add "btnPTC_Fini"
Set Plage = Selection.Range
Plage.Collapse Direction:=wdCollapseEnd
Set btn = Nothing
Set btn = InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1", Range:=Plage)
With btn.OLEFormat.Object
    .Name = "btnPTC_Fini"
    .Caption = "Fini"
    .Font.Bold = True
End With
Set btn = Nothing
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
Selection.TypeText Space(1) '--- 1 espace(ou autre chose) après le bouton pour qu'il y ait quelque chose à sélectionner sur la ligne(sinon la selection est vide)
Selection.TypeText vbCrLf
 
'--- on crée le signet zéro qui sert de repère
Selection.Tables(1).Cell(1, 2).Select
F_ConstructionSignets "btnPTC_Rang_", 0
Selection.TypeText vbCrLf
Selection.TypeText vbCrLf
Selection.TypeText vbCrLf
Selection.TypeText "fin (cas de tous les boutons à zéro non traité)"
 
F_InitPlanTraitEtChrono
 
End Sub
 
Private Sub btnPTC_Rang_1_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_2_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_3_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_4_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_5_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_6_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_7_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_8_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_9_Click()
F_PTCModifRang Me
End Sub
 
Private Sub btnPTC_Rang_10_Click()
F_PTCModifRang Me
End Sub
 
'---------------------------------------------
Private Sub btnPTC_Fini_Click()
'---------------------------------------------
F_OrdreValeurBouton
End Sub
 
'---------------------------------------------
Sub F_PTCModifRang(ByVal Po As Object)
'---------------------------------------------
'--- si le bouton 'Fini' existe
'---       - Modifie la valeur du bouton
'--- sinon - crée le bouton 'Fini'
'---       - trie les boutons dans l'ordre de départ
'---       - ajoute les boutons manquants
'---------------------------------------------
If IsEmpty(btnPTC_Fini) Then    '--- si le bouton 'Fini' n'existe pas
    F_Creation_btnPTC_Fini      '--- on le crée
Else
    '--- recup l'objet en cours (--- si mieux, je suis preneur ---)
    Set oObj = Po.ActiveWindow.Selection.Fields(1).OLEFormat.Object
    oObj.Select
 
    iNouvelleValeur = CInt(oObj.Caption)    '--- recup la valeur du bouton à modifier
 
    Dim iTabVal(GNbBtn) As Integer
    Dim vObj
    Set vObj = Nothing
    For i = 1 To GNbBtn                                                 '--- parcours de la série
        iTabVal(i) = 0                                                  '--- init de la table de travail
        sBtn = "btnPTC_Rang_" & i
        If Me.Bookmarks.Exists(sBtn) Then                               '--- si le signet existe
            Set vObj = F_ExistControlDansLigne(sBtn, Me)                '--- recup le bouton si il existe dans la ligne
            If Not (vObj Is Nothing) Then
                'Debug.Print "-F_PTCModifRang inventaire " & sBtn
                iTabVal(i) = CInt(vObj.OLEFormat.Object.Caption)        '--- récup toutes les valeurs des boutons présents
            End If
        End If
    Next i
    Set vObj = Nothing
 
    '--- Quand la bouton est > zéro, il prend la valeur zéro et décrémente tous les autres de 1 quand leur valeur est supérieure à 'iNouvelleValeur'.
    '--- Quand le bouton est à zéro, il récupère la plus haute valeurs des autres boutons auquel il ajoute 1 et se l'attribue.
 
    If iNouvelleValeur > 0 Then
        For i = 1 To GNbBtn                                             '--- parcours de la série
            If iTabVal(i) > iNouvelleValeur Then                        '--- si la valeur du bouton de la série > 'iNouvelleValeur'
                sBtn = "btnPTC_Rang_" & i
                If Me.Bookmarks.Exists(sBtn) Then                       '--- si le signet existe
                    Set vObj = F_ExistControlDansLigne(sBtn, Me)        '--- recup le bouton si il existe dans la ligne
                    If Not (vObj Is Nothing) Then
                        'Debug.Print "-F_PTCModifRang modif " & sBtn
                        vObj.OLEFormat.Object.Caption = CStr(iTabVal(i) - 1)    '--- valeur du bouton -1
                        Set vObj = Nothing
                    End If
                End If
            End If
        Next i
        iNouvelleValeur = 0
    Else
        For i = 1 To GNbBtn                                     '--- parcours de la série
            n = iTabVal(i)                                      '--- recup la valeur du bouton de la série
            If n > iNouvelleValeur Then iNouvelleValeur = n     '---  > recup de la valeur la + grande pour 'iNouvelleValeur'
        Next i
        iNouvelleValeur = iNouvelleValeur + 1                   '--- +1
    End If
 
    oObj.Caption = CStr(iNouvelleValeur)                        '--- valeur du bouton à modifier
    F_btnCouleur oObj
    Set oObj = Nothing
End If
End Sub
 
'---------------------------------------------
Sub F_btnCouleur(ByVal Po As Object)
'---------------------------------------------
If CInt(Po.Caption) > 0 Then
    Po.BackColor = vbCyan
Else
    Po.BackColor = vbButtonFace
End If
End Sub
 
'---------------------------------------------
Sub F_InitPlanTraitEtChrono()
'---------------------------------------------
For i = 1 To GNbBtn
    F_AjPTC ("btnPTC_Rang_" & i)
Next i
End Sub
 
'---------------------------------------------
Sub F_AjPTC(ByVal Ps As String)
'---------------------------------------------
If F_ExistControlDansTable(Ps, Me) = False Then
 
    F_ConstructionSignet (Ps)
    '--------------- construction bouton
    'Debug.Print "-F_AjPTC av construction bouton " & Ps
    Set Plage = Selection.Range
    Plage.Collapse Direction:=wdCollapseEnd
    Set btn = Nothing
    Set btn = InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1", Range:=Plage)
 
    With btn.OLEFormat.Object
        .Name = Ps
        .Caption = "0"
        .Width = 27
        .Height = 20
        .Font.Bold = True
    End With
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    'Debug.Print "-F_AjPTC ap construction bouton " & Ps
    '---------------
    n = Mid(Ps, InStrRev(Ps, "_") + 1)
    Selection.TypeText "btn" & n & " Texte " & Chr(64 + n)
    Set btn = Nothing
    DoEvents
End If
End Sub
 
'---------------------------------------------
Sub F_Creation_btnPTC_Fini()
'---------------------------------------------
sNom = "btnPTC_Fini"            '--- bouton 'Fini'
Me.Bookmarks(sNom).Select       '--- sélectionne
Set Plage = Selection.Range
Plage.Collapse Direction:=wdCollapseEnd
Set btn = Nothing
Set btn = InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1", Range:=Plage)
With btn.OLEFormat.Object
    .Name = sNom
    .Caption = "Fini"
    .Font.Bold = True
    .Font.Italic = False
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
Selection.TypeText Space(1) '--- 1 espace(ou autre chose) après le bouton pour qu'il y ait quelque chose à sélectionner sur la ligne(sinon la selection est vide)
 
Me.Bookmarks("btnPTC_Rang_0").Select        '--- revient dans la cellule
 
F_OrdreNomBouton                            '--- tri par ordre de depart
DoEvents
F_InitPlanTraitEtChrono                     '--- ajoute les boutons manquants
DoEvents
End Sub
 
'---------------------------------------------
Sub F_OrdreNomBouton()
'---------------------------------------------
'--- tri les boutons par odre de depart
'---------------------------------------------
 
On Error GoTo Err_F_OrdreNomBoutons:
Dim iTabVal(GNbBtn, 2) As Integer
Dim vObj
 
n = 0
For i = 1 To GNbBtn                                         '--- parcours de la série
    sBtn = "btnPTC_Rang_" & i
    If Me.Bookmarks.Exists(sBtn) Then                       '--- si le signet existe
        Set vObj = F_ExistControlDansLigne(sBtn, Me)        '--- recup le bouton si il existe dans la ligne
        If Not (vObj Is Nothing) Then
            n = n + 1                                       '--- comptage des boutons restants
            iTabVal(n, 1) = vObj.OLEFormat.Object.Caption   '--- 1 : récup la valeur du bouton
            iTabVal(n, 2) = i                               '--- 2 : récup l'indice du bouton (= le nom)
            F_btnCouleur vObj.OLEFormat.Object
            Debug.Print "-F_OrdreNomBouton inventaire " & sBtn & "/ btn: " & iTabVal(n, 2) & "/ valeur: " & iTabVal(n, 1)
        End If
    End If
Next i
Set vObj = Nothing
 
'--- réorganise les boutons : on place le 2 derrière le 1, le 3 derrière le 2, ...
For i = 1 To n - 1
 
    sBtn = "btnPTC_Rang_" & iTabVal(i + 1, 2)   '--- indice (nom) du bouton suivant
    sBtn2 = "btnPTC_Rang_" & iTabVal(i, 2)      '--- indice (nom) du bouton 'i'
    X = iTabVal(i + 1, 1)   '--- pour trace
    Debug.Print "-F_OrdreNomBouton interverti " & sBtn & " passe derrière " & sBtn2 & "/ valeur: " & X
 
    Me.Bookmarks(sBtn).Select                   '--- on se positionne sur la signet du bouton suivant (à déplacer derrière le bouton 'i')
    Selection.MoveEnd Unit:=wdLine, Count:=1    '--- selectionne la ligne
    Selection.Range.Cut                         '--- coupe la ligne
 
    Me.Bookmarks(sBtn2).Select                      '--- on se positionne sur la signet du bouton 'i'
    Selection.MoveEnd Unit:=wdLine, Count:=1        '--- selectionne la ligne
    Selection.MoveEnd Unit:=wdCharacter, Count:=-1  '--- fin de ligne -1
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.TypeText vbCrLf                       '--- ajoute un retour à la ligne
    Me.Bookmarks.Add sBtn                           '--- déplace le signet du bouton suivant
    DoEvents
 
    Selection.Paste                                 '--- colle le bouton suivant
    DoEvents
    Selection.Delete                                '--- supprime le retour à la ligne devenu inutile
    DoEvents
 
    F_ListeControls '--- pour trace
    'F_ControleBtn "-F_OrdreNomBoutons"
Next i
 
F_ControleBtn "-Exit_F_OrdreNomBoutons"
 
Exit_F_OrdreNomBoutons:
Exit Sub
 
Err_F_OrdreNomBoutons:
MsgBox Err.Description & " pour " & sBtn, vbApplicationModal + vbMsgBoxSetForeground + vbExclamation, "Err_F_OrdreNomBoutons"
F_RenomeBtn sBtn, "F_OrdreNomBoutons"
Resume Next
End Sub
 
'---------------------------------------------
Sub F_OrdreValeurBouton()
'---------------------------------------------
'--- on supprime le bouton 'Fini'
'--- on supprime les lignes dont la valeur du bouton est zéro
'--- on trie les boutons
'---------------------------------------------
On Error GoTo Err_F_OrdreValeurBouton:
 
'--- supprime le bouton 'Fini'
Me.Bookmarks("btnPTC_Fini").Select
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
 
'--- on se positionne sur le signet zéro
Me.Bookmarks("btnPTC_Rang_0").Select
 
'--- on supprime les lignes dont la valeur du bouton est zéro
F_ElimineBoutonZeroPlanTraitEtChrono
 
Dim iTabVal(GNbBtn, 2) As Integer
Dim vObj
n = 0
For i = 1 To GNbBtn                                                 '--- parcours de la série
    sBtn = "btnPTC_Rang_" & i
    If Me.Bookmarks.Exists(sBtn) Then                               '--- si le signet existe
        Set vObj = F_ExistControlDansLigne(sBtn, Me)                '--- recup le bouton si il existe dans la ligne
        If Not (vObj Is Nothing) Then
            vObj.OLEFormat.Object.BackColor = vbButtonFace          '--- couleur bouton : gris
            n = n + 1                                               '--- comptage des boutons restants
            iTabVal(n, 1) = CInt(vObj.OLEFormat.Object.Caption)     '--- 1 : récup la valeur du bouton
            iTabVal(n, 2) = i                                       '--- 2 : récup l'indice du bouton (= le nom)
            Debug.Print "-F_OrdreValeurBouton recup " & sBtn & "/ btn: " & iTabVal(n, 2) & "/" & "/ val: " & iTabVal(n, 1) & "/ n: " & n
        End If
    End If
Next i
Set vObj = Nothing
 
'--- tri des n boutons trouvés
For j = 1 To n - 1
    For i = 1 To n - j
        If iTabVal(i, 1) > iTabVal(i + 1, 1) Then   '--- swap des boutons selon leur valeurs
 
            ValeurSurBouton = iTabVal(i + 1, 1)
            NumBouton = iTabVal(i + 1, 2)
 
            ValeurSurBoutonCoupé = iTabVal(i, 1)
 
            sBtn = "btnPTC_Rang_" & iTabVal(i, 2)       '--- indice (nom) du bouton 'i'
            sBtn2 = "btnPTC_Rang_" & iTabVal(i + 1, 2)  '--- indice (nom) du bouton suivant
            Debug.Print "-F_OrdreValeurBouton interverti " & sBtn & " passe derrière " & sBtn2 & "/ n: " & n & "/ j: " & j & "/ i: " & i & "/ ValeurSurBouton: " & ValeurSurBouton
 
            Me.Bookmarks(sBtn).Select                   '--- on se positionne sur la signet du bouton 'i'
            Selection.MoveEnd Unit:=wdLine, Count:=1    '--- selectionne la ligne
            Selection.Range.Cut                         '--- coupe la ligne
            'erreur VB: -2147319764 (8002802c)
 
            Me.Bookmarks(sBtn2).Select                      '--- on se positionne sur la signet du bouton suivant
            Selection.MoveEnd Unit:=wdLine, Count:=1        '--- selectionne la ligne
            Selection.MoveEnd Unit:=wdCharacter, Count:=-1  '--- fin de ligne -1
            Selection.Collapse Direction:=wdCollapseEnd
            Selection.TypeText vbCrLf                       '--- ajoute un retour à la ligne
            Me.Bookmarks.Add sBtn                           '--- déplace le signet du bouton suivant
            DoEvents
 
            Selection.Paste                                 '--- colle le bouton 'i'
            DoEvents
            Selection.Delete                                '--- supprime le retour à la ligne devenu inutile
            DoEvents
 
            iTabVal(i + 1, 1) = iTabVal(i, 1)               '--- swap des valeurs du tableau de travail
            iTabVal(i + 1, 2) = iTabVal(i, 2)
            iTabVal(i, 1) = ValeurSurBouton
            iTabVal(i, 2) = NumBouton
 
        End If
        F_ListeControls
        'F_ControleBtn "-F_OrdreValeurBouton"
    Next i
Next j
 
F_ControleBtn "-Exit_F_OrdreValeurBouton"
 
Exit_F_OrdreValeurBouton:
Exit Sub
 
Err_F_OrdreValeurBouton:
MsgBox Err.Description & " pour " & sBtn, vbApplicationModal + vbMsgBoxSetForeground + vbExclamation, "Err_F_OrdreValeurBouton"
F_RenomeBtn sBtn, "F_OrdreValeurBouton"
Resume Next
End Sub
 
'---------------------------------------------
Sub F_ControleBtnInit()
'---------------------------------------------
F_ControleBtn "init"
End Sub
 
'---------------------------------------------
Sub F_ControleBtn(ByVal s As String)
'---------------------------------------------
For i = 1 To GNbBtn
    F_RenomeBtn "btnPTC_Rang_" & i, s
Next i
End Sub
 
'---------------------------------------------
Sub F_RenomeBtn(ByVal Ps As String, ByVal s As String)
'---------------------------------------------
If Me.Bookmarks.Exists(Ps) Then
    Dim vObj
    Set vObj = F_ExistControlDansLigne(Ps, Me)      '--- recherche le bouton 'x' à controler
    If vObj Is Nothing Then
        s1 = Ps & "1"
        Set vObj = F_ExistControlDansLigneErr(Ps, Me, s1)   '--- recherche le bouton 'x1' à controler
        Debug.Print "- ##### renomme (" & s & ")/" & vObj.OLEFormat.Object.Name & " /" & Ps & "/ (valeur:" & vObj.OLEFormat.Object.Caption & ")"
        DoEvents
        If Not (vObj Is Nothing) Then
            Debug.Print "-F_RenomeBtn av" & Ps & "/" & vObj.OLEFormat.Object.Name
            vObj.OLEFormat.Object.Name = Ps
            Debug.Print "-F_RenomeBtn ap" & Ps & "/" & vObj.OLEFormat.Object.Name
            If vObj.OLEFormat.Object.Name = Ps Then Debug.Print "-F_RenomeBtn réussi " & Ps & "/" & vObj.OLEFormat.Object.Name
        End If
        Set vObj = Nothing
        DoEvents
    End If
End If
End Sub
 
'---------------------------------------------
Sub F_ElimineBoutonZeroPlanTraitEtChrono()
'---------------------------------------------
For i = 1 To GNbBtn
    F_SupPTC ("btnPTC_Rang_" & i)
Next i
End Sub
 
'---------------------------------------------
Sub F_SupPTC(ByVal Ps As String)
'---------------------------------------------
'--- supprime la ligne du bouton passé en paramètre
'---------------------------------------------
If Me.Bookmarks.Exists(Ps) Then
    Dim vObj
    Set vObj = Nothing
    Set vObj = F_ExistControlDansLigne(Ps, Me)
    If Not (vObj Is Nothing) Then
        If vObj.OLEFormat.Object.Caption = "0" Then
            Me.Bookmarks(Ps).Select
            Selection.MoveEnd Unit:=wdLine, Count:=1
            Selection.Delete
            Me.Bookmarks(Ps).Delete
            DoEvents
        End If
        Set vObj = Nothing
    End If
End If
End Sub
 
'---------------------------------------------
Sub F_ConstructionSignet(PsNom As String)
'---------------------------------------------
'--- construction d'un seul signet placé derrière l'indice précédent
'---------------------------------------------
If Not Me.Bookmarks.Exists(PsNom) Then
    n = CInt(Mid(PsNom, InStrRev(PsNom, "_") + 1)) - 1
    Nom = Left(PsNom, InStrRev(PsNom, "_"))
    For i = n To 0 Step -1
        If Me.Bookmarks.Exists(Nom & i) Then Exit For
    Next i
    Me.Bookmarks(Nom & i).Select
    Me.Bookmarks("\line").Select
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    Selection.TypeText vbCrLf
    Me.Bookmarks.Add PsNom
End If
Me.Bookmarks(PsNom).Select
DoEvents
End Sub
 
'---------------------------------------------
Sub F_ConstructionSignets(PsNom As String, PiNombre As Integer)
'---------------------------------------------
'--- construction d'une série de signets
'---------------------------------------------
For i = 0 To PiNombre
    If Not Me.Bookmarks.Exists(PsNom & i) Then
        Me.Bookmarks.Add PsNom & i
            Selection.TypeText i & vbCrLf
    End If
    DoEvents
Next i
Selection.TypeBackspace '--- supprime le dernier caractère
End Sub
 
'---------------------------------------------
Sub F_DestructionSignets(PsNom As String, PiNombre As Integer)
'---------------------------------------------
'--- destruction des signets
'---------------------------------------------
For i = 0 To PiNombre
    If Me.Bookmarks.Exists(PsNom & i) Then
        Me.Bookmarks(PsNom & i).Delete
    End If
    DoEvents
Next i
End Sub
 
'---------------------------------------------
Sub F_IdentificationSignet()
'---------------------------------------------
'---
'---------------------------------------------
Me.Bookmarks("\Cell").Select
Set oObj = Selection
For Each signet In oObj.Bookmarks
    Debug.Print signet.Name
Next signet
Selection.Collapse
End Sub
 
'---------------------------------------------
Sub F_ListeControls()
'---------------------------------------------
'---
'---------------------------------------------
Debug.Print "---" & Me.Shapes.Count
For Each ctrl In Me.InlineShapes
    Debug.Print ctrl.OLEFormat.Object.Name
Next ctrl
End Sub
 
'---------------------------------------------
Function F_ExistControlDansLigne(ByVal Ps As String, Po As Object) As Variant
'---------------------------------------------
'--- retourne l'objet trouvé sinon rien
'---------------------------------------------
Dim vObj As Variant
Set vObj = Nothing
On Error GoTo Err_F_ExistControlDansLigne
 
Po.Bookmarks(Ps).Select
Selection.MoveEnd Unit:=wdLine, Count:=1
Set oObj = Selection
For Each ctrl In oObj.InlineShapes
    With ctrl.OLEFormat.Object
        'Debug.Print .Name
        If .Name = Ps Then
            Set vObj = ctrl
            Exit For
        End If
    End With
Next ctrl
Selection.Collapse
Set F_ExistControlDansLigne = vObj
DoEvents
 
Exit_F_ExistControlDansLigne:
Set oObj = Nothing
Set vObj = Nothing
Exit Function
 
Err_F_ExistControlDansLigne:
MsgBox Err.Description, vbApplicationModal + vbMsgBoxSetForeground + vbExclamation, "Err_F_ExistControlDansLigne"
Set F_ExistControlDansLigne = vObj
Resume Next
End Function
 
'---------------------------------------------
Function F_ExistControlDansLigneErr(ByVal Ps As String, Po As Object, ByVal Ps1 As String) As Variant
'---------------------------------------------
'--- retourne le premier objet trouvé dans la ligne du signet passé en paramètre sinon rien
'---------------------------------------------
Dim vObj As Variant
Set vObj = Nothing
On Error GoTo Err_F_ExistControlDansLigneErr
 
Po.Bookmarks(Ps).Select
Selection.MoveEnd Unit:=wdLine, Count:=1
Set oObj = Selection
For Each ctrl In oObj.InlineShapes
    With ctrl.OLEFormat.Object
        Set vObj = ctrl
        Exit For
    End With
Next ctrl
Selection.Collapse
Set F_ExistControlDansLigneErr = vObj
DoEvents
 
Exit_F_ExistControlDansLigneErr:
Set oObj = Nothing
Set vObj = Nothing
Exit Function
 
Err_F_ExistControlDansLigneErr:
MsgBox Err.Description, vbApplicationModal + vbMsgBoxSetForeground + vbExclamation, "Err_F_ExistControlDansLigneErr"
Set F_ExistControlDansLigneErr = vObj
Resume Next
End Function
 
'---------------------------------------------
Function F_ExistControlDansTable(ByVal Ps As String, Po As Object) As Boolean
'---------------------------------------------
'--- retourne vrai si le bouton est trouvé
'---------------------------------------------
Po.Bookmarks("\Cell").Select
Set oObj = Selection
Trouve = False
For Each ctrl In oObj.InlineShapes
    With ctrl.OLEFormat.Object
        If .Name = Ps Then
            Trouve = True
            Exit For
        End If
    End With
Next ctrl
Selection.Collapse
If Trouve = True Then
    F_ExistControlDansTable = True
Else
    F_ExistControlDansTable = False
End If
DoEvents
Set oObj = Nothing
End Function

**nd34d** · 02/09/2011, 13h09

Le problème vient de la propriété '.Name' lors de la suppression suivie immédiatement de la recréation de ces mêmes boutons (pb reproduit avec seulement 2 boutons modifiés).
Maintenant je récupère toutes les infos puis je supprime carrément toute la cellule et je recrée tous les boutons (triés ou non) mais sans les nommer : ils s'appellent CommandButton1, 2, ... avec un code générique qui récupère juste l'objet avec 'ActiveWindow.Selection.InlineShapes(1).OLEFormat.Object' au niveau de la fonction appelée.
Je gère l'emplacement des boutons avec les signets (ajoutès soit les uns à la suite des autres, soit à la suite du précédent (tri))

Si quelqu'un trouve le truc qui 'flush' avant le '.Name' je suis toujours preneur, ou alors je fais une mauvaise utilisation de 'Sélection/Range'.

Tout se passe ici :

Code :

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

1
2
3
4
5
6
7
Me.Bookmarks(PsNom).Select
Set Plage = Selection.Range
Plage.Collapse Direction:=wdCollapseEnd
Set btn = InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1", Range:=Plage)
DoEvents
With btn.OLEFormat.Object
        .Name = PsNom          '--- ici

Déplacement d'un bouton dans un modèle Word

VBA Word

Discussions similaires

Partager

Partager