Bonsoir

je me trouve devant un petit soucis que je n'ai reussi à résoudre ayant pourtant bien recherché , je dispose d'une macro me permettant de copier des feuilles et sur ces feuilles je souhaites ajouter des boutons de formulaire


voici 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
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
    Sub transfertfret()
 
        Dim TRANSITION As Workbook
        Dim ws As Worksheet
        Dim xcell As Range
        Dim chemin As String
        Dim fichier As String
        Dim S As Shape
        chemin = ThisWorkbook.Path
 
        ' A est le classeur sur lequel je me trouve pour executer le code
 
 
        'jouvre le classeur B :
      Workbooks.Open Filename:=chemin & "\B.xls"
       Workbooks("A.xls").Unprotect Password:="start"
       Workbooks.Open Filename:=chemin & "\TRANSITION.xls"
       Workbooks("TRANSITION.xls").Unprotect Password:="start"
 
        'j'effectue une comparaison entre les feuilles du classeur B et la plage b21:b100 feuille 1 du classeur A :
      For Each xcell In Workbooks("A").Sheets("Feuil1").Range("C21:C100")
 
 
 
          For Each ws In Workbooks("B").Worksheets
 
                If xcell = ws.Name Then
 
 
 
                    Set TRANSITION = Workbooks("TRANSITION.xls")
 
 
                   ws.Copy after:=TRANSITION.Sheets(TRANSITION.Sheets.Count)
                   With Workbooks("TRANSITION.xls")
                   For Each S In ActiveSheet.Shapes
                   S.Delete
                    Next S
                    End With
 
 
                 '**************************************************************************************************************************************
       With Workbooks("TRANSITION.xls").ActiveSheet.Buttons.Add(Range("H155:I156").Left, Range("H155:I156").Top, Range("H155:I156").Width, Range("H155:I156").Height)
            '.Select
          .Characters.Text = "IMPRIMER"
 
           .OnAction = " 'TRANSITION.xls'!IMPRESSION"
            With .Characters(Start:=1, Length:=23).Font
                .Name = "Arial"
                .FontStyle = "Normal"
                .Size = 22
                .ColorIndex = xlAutomatic
            End With
       End With
        '*************************************************************************************************************************************************
       With Workbooks("TRANSITION.xls").ActiveSheet.Buttons.Add(Range("c155:B156").Left, Range("c155:B156").Top, Range("c155:B156").Width, Range("c155:B156").Height)
            '.Select
          .Characters.Text = "QUITTER"
            .OnAction = " 'TRANSITION.xls'!QUITTER"
            With .Characters(Start:=1, Length:=7).Font
                .Name = "Arial"
                .FontStyle = "Normal"
                .Size = 20
                .ColorIndex = xlAutomatic
            End With
        End With
        '*********************************************************************************************************************************************
       With Workbooks("TRANSITION.xls").ActiveSheet.Buttons.Add(Range("E155:F156").Left, Range("E155:F156").Top, Range("E155:F156").Width, Range("E155:F156").Height)
            '.Select
          .Characters.Text = "SORTANT"
            .OnAction = " 'TRANSITION.xls'!REVENIR1"
            With .Characters(Start:=1, Length:=7).Font
                .Name = "Arial"
                .FontStyle = "Normal"
                .Size = 20
                .ColorIndex = xlAutomatic
            End With
       End With
        '**********************************************************************************************************************************************
       With Workbooks("TRANSITION.xls").ActiveSheet.Buttons.Add(Range("L155:K156").Left, Range("L155:K156").Top, Range("L155:K156").Width, Range("L155:K156").Height)
            '.Select
          .Characters.Text = "MESURE"
            .OnAction = " 'TRANSITION.xls'!evaluation"
            With .Characters(Start:=1, Length:=7).Font
                .Name = "Arial"
                .FontStyle = "Normal"
                .Size = 20
                .ColorIndex = xlAutomatic
            End With
        End With
 
                End If
 
            Next ws
 
        Next xcell
 
        'enregistre les modifs
    Workbooks("TRANSITION.xls").Protect Password:="start"
 
       Workbooks("TRANSITION.xls").Close True
 
    Workbooks("B.xls").Protect Password:="start"
        Workbooks("B.xls").Close True
 
    End Sub

j'ai un bug à la ligne :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
 With Workbooks("TRANSITION.xls").ActiveSheet.Buttons.Add(Range("E155:F156").Left, Range("E155:F156").Top, Range("E155:F156").Width, Range("E155:F156").Height)

avec l'information "impossible de lire la propriété add de la classe buttons

En vous remerciant pour tout conseil utile , car je n'ai pas réussi à résoudre ce probleme

Cordialement