Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Création boutons par VBA

Création boutons par VBA

2 réponses
Avatar
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:=False,
DisplayAsIcon:=False, Left:=457, Top:=0, Width:=69, Height:=19.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:=False,
DisplayAsIcon:=False, Left:=526, Top:=0, Width:=69, Height:=19.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:=False,
DisplayAsIcon:=False, _
Left:=595, Top:=0, Width:=69, Height:=19.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
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
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é" a écrit dans le message de groupe de 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
Avatar
Joël André
Merci michdenis, je prends.
Joël André

"michdenis" a écrit dans le message de news:

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é" a écrit dans le message de groupe de
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