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
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
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
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
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
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With
End Sub
'---------------------------------------
"Joël André" <joel.andre7@wanadoo.fr> a écrit dans le message de groupe de discussion :
#RK2HwC9KHA.4600@TK2MSFTNGP02.phx.gbl...
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
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
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
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
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
Merci michdenis, je prends.
Joël André
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
1EF25623-7486-4A5A-8BA4-2621CF417F2B@microsoft.com...
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
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With
End Sub
'---------------------------------------
"Joël André" <joel.andre7@wanadoo.fr> a écrit dans le message de groupe de
discussion :
#RK2HwC9KHA.4600@TK2MSFTNGP02.phx.gbl...
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
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
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