[XL-2007] Boutons placés par macro sur feuille ne fonctionnent pas (Bis !) [Résolu]

[Danad38]

Bonjour à tous,

Je travaille avec Excel 2007 et je suis sous Windows 7.

Je croyais bien que Jérome m'avait tiré d'affaire il y a quelques jours pour ce même sujet ... Même s'il m'a été d'un grand secours pour réussir la programmation de mon "bout de code", j'ai cru trop vite que tout était gagné. Ce qui a fonctionné au départ ne fonctionne plus aujourd'hui.
A force de tâtonnements et d'essais, j'ai trouvé ce qui se passe, mais ... POURQUOI ? Voilà mon problème.

Je résume la situation pour les "nouveaux".
J'ai un classeur dans lequel j'ai crée des macros (utilisant des UserForms, des boutons de commande intégrés etc.). Dans ce classeur j'ai une petite trentaine de feuilles dont une se nomme : "Facture - Devis en cours". C'est sur cette feuille qu'apparaissent les Factures ou les Devis. A partir de cette feuille, Factures et Devis sont enregistrés, puis la feuille est "effacée" afin de recevoir la Facture ou Devis suivant.

Une des fonctions programmée permet de rouvrir un fichier "Facture - Devis en cours" déjà enregistrer afin de pouvoir le modifier. Le module qui commande ceci fait deux choses :

1 - Ouverture d'un fichier à choisir dans les répertoires.
2 - Placement sur cette feuille ouverte de deux boutons l'un pour "Enregistrer", l'autre pour "Imprimer".

Tout ceci fonctionne très bien. Voici le code :

Code :

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
Public Message As String
Public NomFichier As String
Public CheminFichier As String
Public CeClasseur As String
Public Enregistrer As String
Public Imprimer As String
 
Sub Réouverture_Facture_ou_Devis()
 
Dim NomClasseur As Workbook
Dim Bouton_Enr As OLEObject
Dim Bouton_lmp As OLEObject
Dim Ws As Worksheet
Dim Enregistrer As String
Dim Imprimer As String
 
MsgBox "Vous allez ouvrir l'arborescence des fichiers. Choisissez votre répertoire et le fichier à ouvrir."
 
Application.Dialogs(xlDialogOpen).Show
 
Set NomClasseur = ActiveWorkbook
 
Range("C5").Select
 
Set Bouton_Enr = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
 
With Bouton_Enr
    .Name = "Enregistrer"
    .Left = 10
    .Top = 30
    .Width = 60
    .Height = 25
    .Object.Caption = "Enregistrer"
 
End With
 
AjoutCodeEnregistrer
 
Set Bouton_Imp = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
With Bouton_Imp
    .Name = "Imprimer"
    .Left = 10
    .Top = 60
    .Width = 60
    .Height = 25
    .Object.Caption = "Imprimer"
 
End With
 
AjoutCodeImprimer
 
End Sub
 
Sub AjoutCodeEnregistrer()
'Référence à ajouter Microsoft Visual Basic for Application Extsensibility 5.3
Dim CeClasseur As VBComponent
Dim i As Integer
Dim NumCom As Integer
Dim Nom As String
Dim FacDev As String
Dim CheminFichier As String
Dim NomFichier As String
 
Set CeClasseur = ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
 
With CeClasseur.CodeModule
    i = .CountOfLines
    .InsertLines i + 1, "Private Sub Enregistrer_Click()"
    .InsertLines i + 2, "Dim CheminFichier As String"
    .InsertLines i + 3, "Dim NomFichier As String"
    .InsertLines i + 4, "Dim FacDev As String"
    .InsertLines i + 5, "Range(""C5"").Select"
    .InsertLines i + 6, "ActiveCell.Select"
    .InsertLines i + 7, "ActiveCell.Offset(-2,3).Select"
    .InsertLines i + 8, "FacDev=ActiveCell.Value"
    .InsertLines i + 9, "'"
    .InsertLines i + 10, "If FacDev=""Facture"" Then"
    .InsertLines i + 11, "CheminFichier=ThisWorkbook.Path & ""\"""
    .InsertLines i + 12, "NomFichier=ActiveWorkbook.Name"
    .InsertLines i + 13, "'"
    .InsertLines i + 14, "With ActiveWorkbook"
    .InsertLines i + 15, ".SaveAs FileName:=CheminFichier & NomFichier"
    .InsertLines i + 16, ".Close"
    .InsertLines i + 17, "End With"
    .InsertLines i + 18, "'"
    .InsertLines i + 19, "Else: CheminFichier=ThisWorkbook.Path & ""\"""
    .InsertLines i + 20, "NomFichier=ActiveWorkbook.Name"
    .InsertLines i + 21, "'"
    .InsertLines i + 22, "With ActiveWorkbook"
    .InsertLines i + 23, ".SaveAs FileName:=CheminFichier & NomFichier"
    .InsertLines i + 24, ".Close"
    .InsertLines i + 25, "'"
    .InsertLines i + 26, "End With"
    .InsertLines i + 27, "'"
    .InsertLines i + 28, "End If"
    .InsertLines i + 29, "'"
    .InsertLines i + 30, "End Sub"
End With
 
End Sub
 
Sub AjoutCodeImprimer()
 
Dim CeClasseur As VBComponent
Dim j As Integer
Dim NumLigne As Integer
Dim NumColonne As Integer
 
 
Set CeClasseur = ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName)
 
With CeClasseur.CodeModule
    j = .CountOfLines
    .InsertLines j + 1, "Private Sub Imprimer_Click()"
    .InsertLines j + 2, "'"
    .InsertLines j + 3, "Dim NumLigne As Integer"
    .InsertLines j + 4, "Dim NumColonne As Integer"
    .InsertLines j + 5, "'"
    .InsertLines j + 6, "Columns(""J:J"").Find(""----------"", [J1], , , , xlPrevious).Select"
    .InsertLines j + 7, "ActiveCell.Offset(-1, 0).Select"
    .InsertLines j + 8, "'"
    .InsertLines j + 9, "NumLigne = ActiveCell.Row"
    .InsertLines j + 10, "NumColonne = ActiveCell.Column"
    .InsertLines j + 11, "'"
    .InsertLines j + 12, "Range(""A1"" & "":J"" & NumLigne).Select"
    .InsertLines j + 13, "'"
    .InsertLines j + 14, "With Sheets(""Facture - Devis en cours"").PageSetup"
    .InsertLines j + 15, ".PrintArea = ""A1"" & "":J"" & NumLigne"
    .InsertLines j + 16, ".PaperSize = xlPaperA4"
    .InsertLines j + 17, ".CenterHorizontally = True"
    .InsertLines j + 18, ".Orientation = xlPortrait"
    .InsertLines j + 19, ".Zoom = False"
    .InsertLines j + 20, ".FitToPagesWide = 1"
    .InsertLines j + 21, ".FitToPagesTall = 2"
    .InsertLines j + 22, "End With"
    .InsertLines j + 23, "Sheets(""Facture - Devis en cours"").PrintOut"
    .InsertLines j + 24, "End Sub"
End With
 
End Sub

Mon problème vient du fait que ces boutons fonctionnent ... puis ne fonctionnent plus.

Aujourd'hui, j'ai défini ce qui se produit :
Lorsque j'ouvre pour la première fois un fichier (par exemple : "26-11-2011--41-TOTO.xls") celui-ci s'ouvre, les boutons s'affichent et j'ai un module qui se crée (que je peux voir dans l'éditeur VBA). Le code de se module est (me semble-t-il) correct. Voici ce code :

Code :

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
Private Sub Enregistrer_Click()
Dim CheminFichier As String
Dim NomFichier As String
Dim FacDev As String
Range("C5").Select
ActiveCell.Select
ActiveCell.Offset(-2, 3).Select
FacDev = ActiveCell.Value
'
If FacDev = "Facture" Then
CheminFichier = ThisWorkbook.Path & "\"
NomFichier = ActiveWorkbook.Name
'
With ActiveWorkbook
.SaveAs Filename:=CheminFichier & NomFichier
.Close
End With
'
Else: CheminFichier = ThisWorkbook.Path & "\"
NomFichier = ActiveWorkbook.Name
'
With ActiveWorkbook
.SaveAs Filename:=CheminFichier & NomFichier
.Close
'
End With
'
End If
'
End Sub
Private Sub Imprimer_Click()
'
Dim NumLigne As Integer
Dim NumColonne As Integer
'
Columns("J:J").Find("----------", [J1], , , , xlPrevious).Select
ActiveCell.Offset(-1, 0).Select
'
NumLigne = ActiveCell.Row
NumColonne = ActiveCell.Column
'
Range("A1" & ":J" & NumLigne).Select
'
With Sheets("Facture - Devis en cours").PageSetup
.PrintArea = "A1" & ":J" & NumLigne
.PaperSize = xlPaperA4
.CenterHorizontally = True
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
End With
Sheets("Facture - Devis en cours").PrintOut
End Sub

Ce qui suit me semble important, dans la "Zone de liste objet" de la fenêtre du code du module (fenêtre en haut et à gauche), si je déroule cette liste elle comprend :
a - Général
b - Enregistrer
c - Imprimer
d - Worksheet

Dans cette situation, si je reviens vers la feuille que j'ai rouverte et si je click sur les boutons Imprimer et Enregistrer, tout fonctionne normalement.
MAIS.
Si par la suite j'ouvre à nouveau ce même classeur, tout se déroule normalement mais je n'ai plus aucune action si je click sur les boutons de la feuille (En revanche, depuis la fenêtre de code du module, une pression sur F5, provoque sans problème le lancement de l'impression ou de l'enregistrement.

J'ai alors constaté que dans la "Zone de liste Objet", la liste comprenait alors deux lignes supplémentaires :
a - Général
b - CommandButton1
c - CommandButton2
d - Enregistrer
e - Imprimer
d - Worksheet

J'ai également constaté que si, manuellement, dans mon module de code, je remplaçais la ligne :
Sub Enregistrer_click()
par
Sub CommanButton1_click()

et
Sub Imprimer_click()
par
Sub CommandButton2_click()

Et bien les "fameux boutons" de la feuille ouverte fonctionnaient correctement.

Si, bien sûr je rouvre une troisième fois le même fichier, la "Zone de liste objet" comporte deux lignes de plus portant les noms de CommandButton3 et 4 ...

Je pense donc que c'est lors du réenregistrement du fichier qu'il se passe "quelque chose ...".

Avez-vous une idée ? Où est mon erreur ?

Par avance merci pour votre aide.

Danad38

[ctac_]

Bonjour,

Essayer de rajouter ça dans le code :

Code :

1
2
3
4
5
6
7
8
 
On Error Resume Next
Set Bouton_Enr = ActiveSheet.OLEObjects("Enregistrer")
On Error GoTo 0
If Bouton_Enr Is Nothing Then
    Set Bouton_Enr = ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
    '.... la suite
End If

Puis la même chose avec l'autre bouton

ctac

[Danad38]

Bonjour ctac,

Tout d'abord excuse moi pour cette réponse qui a tardé un peu, j'étais absent ce dimanche.

En ce qui concerne mon problème j'ai envie, immédiatement, de dire BRAVO et MERCI ! En effet tout semble fonctionner pour le mieux et je n'ai plus cet "empilement de créations de CommandButton1 dans la Zone de Liste Objet.
Cependant, j'avais crié victoire un peu vite après l'aide indéniable de Jérome. Je vais donc poursuivre un peu mes tests avant de placer cette discussion comme résolue.
En attendant, merci à toi et à tous ceux qui venez en aide aux "novices" comme moi.

Danad38

[Danad38]

Bonjour à tous,

Comme promis, je vais pouvoir clore ce fil de discussion. En effet, la procédure proposée fonctionne parfaitement dans tous les essais que j'ai pu réaliser.
Je vais donc placer (j'espère définitivement) ce sujet comme "Résolu".

Merci encore à vous tous.

Danad38