[XL-2003] Lecture de la propriété add de la classe buttons [Résolu]

StandManMike · 03/02/2012, 18h55

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

mercatog · 03/02/2012, 21h28

Utilise plutôt des variables objets pour pouvoir arriver au résultat.
Exemple

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
Sub TransfertFret()
Dim WbkB As Workbook, WbkT As Workbook
Dim WsB As Worksheet, WsT As Worksheet
Dim Chemin As String
Dim xCell As Range
Dim S As Shape
 
Chemin = ThisWorkbook.Path
'jouvre le classeur B :
Set WbkB = Workbooks.Open(Chemin & "\B.xls")
WbkB.Unprotect Password:="start"
Set WbkT = Workbooks.Open(Chemin & "\TRANSITION.xls")
WbkT.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 ThisWorkbook.Sheets("Feuil1").Range("C21:C100")
    For Each WsB In WbkB.Worksheets
        If xCell = WsB.Name Then
            WsB.Copy after:=WbkT.Sheets(WbkT.Sheets.Count)
            Set WsT = WbkT.Sheets(WbkT.Sheets.Count)
            With WsT
                For Each S In .Shapes
                    S.Delete
                Next S
                '**************************************************************************************************************************************
                With .Buttons.Add(.Range("H155").Left, .Range("H155").Top, .Range("H155:I155").Width, .Range("H155:H156").Height)
                    .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
            End With
            '**************************************************************************************************************************************
            'les autres boutons (ou bien mettre une procédure générique qui a comme paramètres le Text, OnActions et position du bouton
            Set WsT = Nothing
        End If
    Next WsB
Next xCell
 
'enregistre les modifs
With WbkT
    .Protect Password:="start"
    .Close True
End With
Set WbkT = Nothing
 
WbkB.Close False
Set WbkB = Nothing
End Sub

StandManMike · 04/02/2012, 11h19

Merci pour cette réponse , ayant toutefois repris la correction que tu m'a proposé j'ai toujours le meme message d'erreur à la meme ligne !

mercatog · 04/02/2012, 12h28

Ayant testé avec succès le code que j'avais proposé et ne voyant pas ton dernier code, je ne peux pas deviner la cause.

StandManMike · 04/02/2012, 15h02

Mon code est tel que celui que j'ai donné , j'ai repris integralement votre

correction et j'ai toujours le meme message d'erreur

c'est à ne rien y comprendre ! ... là j'avoue etre depassé

mercatog · 04/02/2012, 15h25

Si c'est pas trop te demander, il est souhaitable que tu reportes ici ton code tel que testé.
Peut être quelque chose t'as échappé lors de l'adaptation.
Sinon, qu'est ce que ta feuille a de spécial?

StandManMike · 04/02/2012, 15h49

le voici mais rien de plus que votre adaptation :

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
Sub TransfertFret()
Dim WbkB As Workbook, WbkT As Workbook
Dim WsB As Worksheet, WsT As Worksheet
Dim Chemin As String
Dim xCell As Range
Dim S As Shape
 
Chemin = ThisWorkbook.Path
'jouvre le classeur B :
Set WbkB = Workbooks.Open(Chemin & "\B.xls")
WbkB.Unprotect Password:="start"
Set WbkT = Workbooks.Open(Chemin & "\TRANSITION.xls")
WbkT.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 ThisWorkbook.Sheets("Feuil1").Range("C21:C100")
    For Each WsB In WbkB.Worksheets
        If xCell = WsB.Name Then
            WsB.Copy after:=WbkT.Sheets(WbkT.Sheets.Count)
            Set WsT = WbkT.Sheets(WbkT.Sheets.Count)
            With WsT
                For Each S In .Shapes
                    S.Delete
                Next S
                '**************************************************************************************************************************************
                With .Buttons.Add(.Range("H155").Left, .Range("H155").Top, .Range("H155:I155").Width, .Range("H155:H156").Height)
                    .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
            End With
            '**************************************************************************************************************************************
            'les autres boutons (ou bien mettre une procédure générique qui a comme paramètres le Text, OnActions et position du bouton
            Set WsT = Nothing
        End If
    Next WsB
Next xCell
 
'enregistre les modifs
With WbkT
    .Protect Password:="start"
    .Close True
End With
Set WbkT = Nothing
 
WbkB.Close False
Set WbkB = Nothing
End Sub

je me demande s'il n'y a pas eventuellement une option à activer dans excel pour que vba puisse lire la" proprieté add de la classe button"

et c'est toujours cette ligne qui bloque :

Code :

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

With .Buttons.Add(.Range("H155").Left, .Range("H155").Top, .Range("H155:I155").Width, .Range("H155:H156").Height)

mercatog · 04/02/2012, 16h25

Au lieu de cette ligne, mets celle là

Code :

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

With .Buttons.Add(100, 200, 60,25)

Citation:

Sinon, qu'est ce que ta feuille a de spécial?

StandManMike · 04/02/2012, 16h53

je pense que mon vba pète un cable !!!!!!!!!!!!!!!!

en attendant de tester ta dernière proposition , il vient d'arriver

une anomalie sur la ligne

Code :

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

1
2
3
For Each S In .Shapes
                    S.Delete
                Next S

au niveau de

Code :

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

 S.Delete

!!!! avec " ERREUR DEFINIE PAR L'APPLICATION OU PAR L'OBJET "

sa rend fou !!!!!!!!!!!!!!!!!!!!

mercatog · 04/02/2012, 17h05

Ta feuille est elle protégée?

StandManMike · 04/02/2012, 17h12

oui ....

cela jouerai en quoi ?

mercatog · 04/02/2012, 17h22

Sur une feuille protégée, est ce que tu peux manuellement supprimer ou ajouter un bouton?

StandManMike · 04/02/2012, 18h57

je crois que j'y suis !! en tout cas je te remercie d'avoir suivit

mon probleme et merci encor pour les réponses que tu m'a apporté

04/02/2012, 12h28	#4
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	Ayant testé avec succès le code que j'avais proposé et ne voyant pas ton dernier code, je ne peux pas deviner la cause. __________________ Cordialement.
	10

04/02/2012, 15h25	#6
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	Si c'est pas trop te demander, il est souhaitable que tu reportes ici ton code tel que testé. Peut être quelque chose t'as échappé lors de l'adaptation. Sinon, qu'est ce que ta feuille a de spécial? __________________ Cordialement.
	10

04/02/2012, 17h05	#10
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	Ta feuille est elle protégée? __________________ Cordialement.
	00

04/02/2012, 17h22	#12
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	Sur une feuille protégée, est ce que tu peux manuellement supprimer ou ajouter un bouton? __________________ Cordialement.
	10

04/02/2012, 11h19	#3
StandManMike Invité régulier Inscription : février 2012 Messages : 12 Détails du profil Informations forums : Inscription : février 2012 Messages : 12 Points : 5 Points : 5	Merci pour cette réponse , ayant toutefois repris la correction que tu m'a proposé j'ai toujours le meme message d'erreur à la meme ligne !
	00

04/02/2012, 15h02	#5
StandManMike Invité régulier Inscription : février 2012 Messages : 12 Détails du profil Informations forums : Inscription : février 2012 Messages : 12 Points : 5 Points : 5	Mon code est tel que celui que j'ai donné , j'ai repris integralement votre correction et j'ai toujours le meme message d'erreur c'est à ne rien y comprendre ! ... là j'avoue etre depassé
	00

04/02/2012, 17h12	#11
StandManMike Invité régulier Inscription : février 2012 Messages : 12 Détails du profil Informations forums : Inscription : février 2012 Messages : 12 Points : 5 Points : 5	oui .... cela jouerai en quoi ?
	00

04/02/2012, 18h57	#13
StandManMike Invité régulier Inscription : février 2012 Messages : 12 Détails du profil Informations forums : Inscription : février 2012 Messages : 12 Points : 5 Points : 5	je crois que j'y suis !! en tout cas je te remercie d'avoir suivit mon probleme et merci encor pour les réponses que tu m'a apporté
	00

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email