pb pour les pros

  • Initiateur de la discussion Alexandre
  • Date de début
A

Alexandre

Guest
Re tlm

dans une procédure, j'ai une instruction qui a pour effet de
créer un bouton de commande sur une feuille (ici, il n'est donc pas un contrôle, mais un objet) ; g écris :

With ActiveSheet
.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=576, Top:=81.5, Width:=72, Height:= _
24).Select
.OLEObjects("CommandButton1").Object.Caption = "run me"
End With

le pb, c'est que j'aimerai attribuer un code à ce bouton...
comment je peux faire ça ?

Merci !!

Alex
 
C

Celeda

Guest
Bonjour,

Alexandre : je t'encourage à relire la Charte.

Ce genre de titre est à proscrire en premier parce qu'il ne veut rien dire en premier et en second parce que dans ce forum il y a un moteur de recherche et qu'il est nécessaire d'avoir un titre évident pour qu'il fonctionne correctement.

Si on veut savoir comment faire pour un probléme de bouton on tape bouton on tapera pas''question pour les pros'' (il y a des gens ici qui ne sont pas des pros d'ailleurs mais qui sont tout autant trés doués ou douées).

En second, il aurait mieux valu rester sur le bouton du départ, oups sur le post de départ pour poursuivre la recherche de solution.

Et Merci Myta, j'ai bien compris maintenant,avec ton explication que l'on pouvait changer directement dans la procédure le caption et le nom du bouton en restant dans la procédure initiale (mais j'ai pu faire directement le changement de caption et de nom en passant bien par les propriétés une fois le bouton crée selon la procédure et j'ai pu déclencher une autre procédure en passant par l'événement du bouton Private Sub CommandButton1_Click()
c'est là que tu lui mets ta procédure X, tel que je l'avais expliqué)

Mais là, apparemment on doit vouloir déclencher cet événement tout en en restant toujours dans la procédure initiale ? ou alors ?



Celeda
 
A

Alexandre

Guest
Bonjour ,

celeda : oui, excuse, tu as raison, je n'y avais pas pensé, mes titres de msg seront désormais beaucoup + explicites...

Pour mon pb, tu as vu juste !
je souhaiterai attribuer une procédure au bouton créé en restant dans la procédure initiale...

Si qqun peut m'aider...
 
Z

Zon

Guest
Salut,

Pour les controles ActiveX il faut créer le code à la volée aussi

Par exemple:

Sub CReeBotuon()
Dim Ctrl As OLEObject
Dim Lebouton As MSForms.CommandButton
Dim Code$
With ActiveSheet
Set Ctrl = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=576, Top:=81.5, Width:=72, Height:=24)
End With
Set Lebouton = Ctrl.Object
Lebouton.Caption = "RunMe"

Code = "Private Sub " & Lebouton.Name & "_Click()" & vbCrLf
Code = Code & "Msgbox" & """Coucou XLD""" & vbCrLf
Code = Code & "End Sub" & vbCrLf & vbCrLf

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.insertLines .CountOfLines + 1, Code
End With
End Sub

Alexandre, il faut que tu supprimes le bouton avnt d'en créer un autre....

A+++
 
A

Alexandre

Guest
bonjour Zon

Merci bcp pour ta réponse !

Malheureusement, g essayé ta solution, mais ça marche pas...sans doute parce que le code est un peu compliqué et je n'arrive pas à l'adapter dans le mien ...

Voici la tête du code que je voudrais affecter au bouton qui se créé automatiquement dans une feuille excel. Pour l'instant, je l'ai écrit dans un module :


Private Sub procedurecontrole()

Dim reponse, MyValue

For Each C In Range(Range("H7"), Range("H200").End(xlUp)) 'Passer en revue les cellules de la zone SAISIE de la colonne A

'contrôler qu'une quantité a bien été entrée à côté des PU
If C.Offset(0, 1) = "" Then 'regarder dans la cellule de la même ligne (0), à droite (1)
C.Select
reponse = MsgBox("Attention ! vous avez oublié d'entrer une quantité ! Souhaitez vous corriger ?", vbYesNo + vbCritical + vbDefaultButton2, "CORRECTION ") ' affiche le message

If reponse = vbYes Then ' si l'utilisateur a choisi oui.
MyValue = InputBox("Veuillez entrer votre correction !", "Nouvelle Quantité", "") ' Affiche le message, le titre et la valeur par défaut.
C.Offset(0, 1) = MyValue ' Correction
End If
End If
Next

'calcul du cout total

Range("J7").Select
numlign = 7

Do While ActiveCell.Value <> "" 'tant qu'il n'y a rien dans la cellule active (C9),
numlign = numlign + 1 'ne pas changer de ligne ; sinon incrémenter numlign
cells(numlign, "J").Select 'sélectionner la 1ere cellule vierge
Loop

'selectionne la 1ere cellule disponible

ActiveCell.Select
ActiveCell.FormulaR1C1 = "=SUM(R7C10:R[-1]C)" 'faire la somme de J7 (Row7Col10) à 1 ligne au dessus de la cellule active
miseenforme


ActiveCell.Offset(0, -2).Select
ActiveCell = "Cout total"
miseenforme

ActiveCell.Offset(0, 1).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

ActiveCell.Offset(0, 2).Copy
Sheets("pdt interm").Select
Range("F4").Select
numlign = 4
Do While ActiveCell.Value <> "" 'tant qu'il n'y a rien dans la cellule active (C9),
numlign = numlign + 1 'ne pas changer de ligne ; sinon incrémenter numlign
cells(numlign, "f").Select 'sélectionner la 1ere cellule vierge
Loop
ActiveSheet.Paste link:=True

Sheets(nom).Select
Range("D3").Select
Sheets("pdt interm").Select
Range("A4").Select
numlign = 4
Do While ActiveCell.Value <> "" 'tant qu'il n'y a rien dans la cellule active (C9),
numlign = numlign + 1 'ne pas changer de ligne ; sinon incrémenter numlign
cells(numlign, "A").Select 'sélectionner la 1ere cellule vierge
Loop
ActiveSheet.Paste link:=True
End Sub


J'espere qu'il est possible d'affecter ce code au bouton de commande.

Ca serait sympa si qqun pouvait m'aider ....

Alex
 
T

Ti

Guest
ton affaire a l'air assez compliquée, alors ne serait-il pas plus simple de copier une feuille entière (éventuellement masquée) contenant déjà ce bouton et son code associé. Tu n'aurais plus alors qu'à mettre à jour les plages de valeurs de cette feuille, mais là un simple copier-coller suffirait.
 
Z

Zon

Guest
Salut,

Comme ta procedure "procedurecontrole" existe déjà mets la en sub pour y avoir accées depuis tous les modules.

Dans ton bouton créé à la volée tu as juste une ligne à changer

Code = "Private Sub " & Lebouton.Name & "_Click()" & vbCrLf
Code = Code & "procedurecontrole" & vbCrLf '<=====ICI
Code = Code & "End Sub" & vbCrLf & vbCrLf


A+++
 
A

Alexandre

Guest
Grand chef Zon,

merci tout d'abord, après un moment passé sur le code, g compris ce qu'il voulait dire.
G fait comme tu m'as dit, g mis dans une sub ma "procedurecontrole".
Ca marche presque.

En premier lieu, g modifié un tt p'tit peu ton (tres beau) code. VB n'aimait pas :
Set Lebouton = Ctrl.Object
Donc, comme g aucun autre bouton de commande sur la feuille, et que par défaut, le 1er bouton
de commande créé s'appelle CommandButton1, g déclaré Commandbutton1 commme Msform, et g changé le nom dans
la procédure par la suite.(enfin, j'pense pas m'être planté la dessus) ;p
Voilà ce que ca donne :

Sub creerbouton()
Dim Ctrl As OLEObject
Dim CommandButton1 As MSForms.CommandButton
Dim Code$

With ActiveSheet
Set Ctrl = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, _
Left:=576, Top:=81.5, Width:=72, Height:=24)
End With

'Set Lebouton = Ctrl.Object
Ctrl.Object.Caption = "ok"

'écriture du code dans la feuille nouvellement créée

Code = "Private Sub " & "CommandButton1" & "_Click()" & vbCrLf
Code = Code & "procedurecontrole" & vbCrLf
Code = Code & "End Sub" & vbCrLf & vbCrLf

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.insertLines .CountOfLines + 1, Code
End With

End Sub


En fait il plante au moment d'ajouter les lignes dans la feuille crée qui contient le bouton, tout à la fin.
Je ne sais pas pkoi....
G une erreur "Automation" : L'objet invoqué s'est déconnecté de ses clients.
Pour moi, ca veut pas dire grand chose...

Peut être comprends-tu cette langue ? ... ;p

MErci...

Alexandre


PS : merci aussi TI, j'essaierai ta soluce si j'arrive pas à faire de cette façon
 

Statistiques des forums

Discussions
314 190
Messages
2 106 991
Membres
109 733
dernier inscrit
chardou