Création boutons par VBA

Le
Joël André
Bonjour,

J'essaie d'écrire une procédure pour la création de boutons par VBA avec
ajout du code.
Si les code attaché aux boutons n'est pas écrit, les boutons sont bien
créés.
Si le code attaché aux boutons est ajouté, apparition d'une erreur..!
J'ai cherché sur le web, (peut-être pas au bon endroit?) mais n'ai rien
trouvé pour plusieurs boutons!

Voici, ci-dessous, le code de génération qui pose problème.

Merci pour vos idées et votre temps.

Joël André

'Ici, les boutons commande sont créés
With ActiveSheet.OLEObjects

' Bouton Aide Générale - N° 1
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, Left:E7, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeAideGénérale"
With .Object
.Caption = "Aide Générale"
.ForeColor = &HFF0000
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
' Ici, le code se rapportant au bouton est construit
Code = " " & vbCrLf
Code = " Private Sub CommandeAideGénérale_Click() ' Affiche
l'aide générale" & vbCrLf
Code = Code & " QuelleAide = 2" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " AfficheAideGénérale ' 10*****" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " End Sub"
' Ici, le code est écrit dans le module de la feuille du bouton
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

' Bouton Série Directe - N° 2
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, Left:R6, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeSérieDirecte"
With .Object
.Caption = "Série Directe"
.ForeColor = &HC0C0&
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
Code = " " & vbCrLf
Code = Code & " Private Sub CommandeSérieDirecte_Click() ' Teste
la série en directe, sans la stocker" & vbCrLf
Code = Code & " ActiveSheet.Unprotect" & vbCrLf
Code = Code & " LigneSaisieEnCours = 3 ' en saisie Tableau
Résultats" & vbCrLf
Code = Code & " ColonneSaisieEnCours = 3 ' en saisie Tableau
Résultats" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " VérifieContenueSaisieEnCours ' 13*****" &
vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " If CertifieSérie = True Then
SérieDirecteSansSaisieRapport ' 17*****" & vbCrLf
Code = Code & " ActiveSheet.Protect" & vbCrLf
Code = Code & " End Sub"
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

' Bouton Extrait Série - N° 3
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, _
Left:Y5, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeExtraitSérie"
With .Object
.Caption = "Extrait Série"
.ForeColor = &H80000012
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
Code = " " & vbCrLf
Code = Code & " Private Sub CommandeExtraitSérie_Click() '
Extrait la série d'une position" & vbCrLf
Code = Code & " ActiveSheet.Unprotect" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " RechercheSérieSurPosition ' 31*****" &
vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " ActiveSheet.Protect" & vbCrLf
Code = Code & " End Sub"
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

End With
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #22120721
Bonjour,

Voici un exemple de code pour ajouter un bouton de commande
émanant de la boîte à outils "Contrôle" dans une feuille tout en
ajoutant ledit module le code associé au bouton.

'---------------------------------------
Sub test()
Dim Obj As OLEObject, Code As String

With ActiveSheet
Set Obj = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:úlse, DisplayAsIcon:úlse, _
Left:E7, Top:=0, Width:i, Height:.5)
With Obj
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeAideGénérale"
With .Object
.Caption = "Aide Générale"
.ForeColor = &HFF0000
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
End With

Code = "Private Sub CommandeAideGénérale_Click()" & vbCrLf
Code = Code & "Msgbox ""Bonjour à tous""" & vbCrLf
Code = Code & "End Sub"

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With
End Sub
'---------------------------------------




"Joël André" #
Bonjour,

J'essaie d'écrire une procédure pour la création de boutons par VBA avec
ajout du code.
Si les code attaché aux boutons n'est pas écrit, les boutons sont bien
créés.
Si le code attaché aux boutons est ajouté, apparition d'une erreur..!
J'ai cherché sur le web, (peut-être pas au bon endroit?) mais n'ai rien
trouvé pour plusieurs boutons!

Voici, ci-dessous, le code de génération qui pose problème.

Merci pour vos idées et votre temps.

Joël André

'Ici, les boutons commande sont créés
With ActiveSheet.OLEObjects

' Bouton Aide Générale - N° 1
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, Left:E7, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeAideGénérale"
With .Object
.Caption = "Aide Générale"
.ForeColor = &HFF0000
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
' Ici, le code se rapportant au bouton est construit...
Code = " " & vbCrLf
Code = " Private Sub CommandeAideGénérale_Click() ' Affiche
l'aide générale" & vbCrLf
Code = Code & " QuelleAide = 2" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " AfficheAideGénérale ' 10*****" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " End Sub"
' Ici, le code est écrit dans le module de la feuille du bouton
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

' Bouton Série Directe - N° 2
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, Left:R6, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeSérieDirecte"
With .Object
.Caption = "Série Directe"
.ForeColor = &HC0C0&
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
Code = " " & vbCrLf
Code = Code & " Private Sub CommandeSérieDirecte_Click() ' Teste
la série en directe, sans la stocker" & vbCrLf
Code = Code & " ActiveSheet.Unprotect" & vbCrLf
Code = Code & " LigneSaisieEnCours = 3 ' en saisie Tableau
Résultats" & vbCrLf
Code = Code & " ColonneSaisieEnCours = 3 ' en saisie Tableau
Résultats" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " VérifieContenueSaisieEnCours ' 13*****" &
vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " If CertifieSérie = True Then
SérieDirecteSansSaisieRapport ' 17*****" & vbCrLf
Code = Code & " ActiveSheet.Protect" & vbCrLf
Code = Code & " End Sub"
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

' Bouton Extrait Série - N° 3
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, _
Left:Y5, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeExtraitSérie"
With .Object
.Caption = "Extrait Série"
.ForeColor = &H80000012
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
Code = " " & vbCrLf
Code = Code & " Private Sub CommandeExtraitSérie_Click() '
Extrait la série d'une position" & vbCrLf
Code = Code & " ActiveSheet.Unprotect" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " RechercheSérieSurPosition ' 31*****" &
vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " ActiveSheet.Protect" & vbCrLf
Code = Code & " End Sub"
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

End With
Joël André
Le #22122421
Merci michdenis, je prends.
Joël André

"michdenis"
Bonjour,

Voici un exemple de code pour ajouter un bouton de commande
émanant de la boîte à outils "Contrôle" dans une feuille tout en
ajoutant ledit module le code associé au bouton.

'---------------------------------------
Sub test()
Dim Obj As OLEObject, Code As String

With ActiveSheet
Set Obj = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:úlse, DisplayAsIcon:úlse, _
Left:E7, Top:=0, Width:i, Height:.5)
With Obj
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeAideGénérale"
With .Object
.Caption = "Aide Générale"
.ForeColor = &HFF0000
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
End With

Code = "Private Sub CommandeAideGénérale_Click()" & vbCrLf
Code = Code & "Msgbox ""Bonjour à tous""" & vbCrLf
Code = Code & "End Sub"

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With
End Sub
'---------------------------------------




"Joël André" discussion :
#
Bonjour,

J'essaie d'écrire une procédure pour la création de boutons par VBA avec
ajout du code.
Si les code attaché aux boutons n'est pas écrit, les boutons sont bien
créés.
Si le code attaché aux boutons est ajouté, apparition d'une erreur..!
J'ai cherché sur le web, (peut-être pas au bon endroit?) mais n'ai rien
trouvé pour plusieurs boutons!

Voici, ci-dessous, le code de génération qui pose problème.

Merci pour vos idées et votre temps.

Joël André

'Ici, les boutons commande sont créés
With ActiveSheet.OLEObjects

' Bouton Aide Générale - N° 1
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, Left:E7, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeAideGénérale"
With .Object
.Caption = "Aide Générale"
.ForeColor = &HFF0000
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
' Ici, le code se rapportant au bouton est construit...
Code = " " & vbCrLf
Code = " Private Sub CommandeAideGénérale_Click() ' Affiche
l'aide générale" & vbCrLf
Code = Code & " QuelleAide = 2" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " AfficheAideGénérale ' 10*****" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " End Sub"
' Ici, le code est écrit dans le module de la feuille du bouton
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

' Bouton Série Directe - N° 2
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, Left:R6, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeSérieDirecte"
With .Object
.Caption = "Série Directe"
.ForeColor = &HC0C0&
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
Code = " " & vbCrLf
Code = Code & " Private Sub CommandeSérieDirecte_Click() ' Teste
la série en directe, sans la stocker" & vbCrLf
Code = Code & " ActiveSheet.Unprotect" & vbCrLf
Code = Code & " LigneSaisieEnCours = 3 ' en saisie Tableau
Résultats" & vbCrLf
Code = Code & " ColonneSaisieEnCours = 3 ' en saisie
Tableau
Résultats" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " VérifieContenueSaisieEnCours ' 13*****" &
vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " If CertifieSérie = True Then
SérieDirecteSansSaisieRapport ' 17*****" & vbCrLf
Code = Code & " ActiveSheet.Protect" & vbCrLf
Code = Code & " End Sub"
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

' Bouton Extrait Série - N° 3
.Add(ClassType:="Forms.CommandButton.1", Link:úlse,
DisplayAsIcon:úlse, _
Left:Y5, Top:=0, Width:i, Height:.5).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = False
.Name = "CommandeExtraitSérie"
With .Object
.Caption = "Extrait Série"
.ForeColor = &H80000012
.Font.Name = "arial"
.Font.Bold = True
.Font.Size = 8
End With
End With
Code = " " & vbCrLf
Code = Code & " Private Sub CommandeExtraitSérie_Click() '
Extrait la série d'une position" & vbCrLf
Code = Code & " ActiveSheet.Unprotect" & vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " RechercheSérieSurPosition ' 31*****" &
vbCrLf
Code = Code & " " & vbCrLf
Code = Code & " ActiveSheet.Protect" & vbCrLf
Code = Code & " End Sub"
With
ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With

End With


Publicité
Poster une réponse
Anonyme