Bouton avec code

Bonjour à tous,

J'ai un bouton dans un onglet d'excel qui m'ouvre un onglet existant et me crée un bouton dessus.

Je voudrais savoir comment faire pour ajouter du code sur ce deuxième bouton qui me permettra d'ouvrir un autre onglet existant.

J'ai donc ce code qui après click sur le premier bouton, fait une recherche et, si elle est fructueuse, m'ouvre un onglet existant et crée un bouton dessus.

Private Sub Chercher_Click()
On Error Resume Next

Sheets(Range("B19").Value).Visible = 1
If Err <> 0 Then
   MsgBox "Pas d'invité avec ce nom dans la liste. Faites une autre recherche. Attention à l'orthographe et aux accents.", , "Message Erreur"
End If
Sheets(Range("B19").Value).Activate
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
        , DisplayAsIcon:=False, Left:=183.75, Top:=119.25, Width:=169.5, _
        Height:=79.5).Select
ActiveSheet.Shapes("CommandButton1").Select

End Sub

Je voudrais donc ajouter du code sur ce bouton, style :

Sheets("Modification").Activate

mais je ne sais pas comment l'appliquer à ce bouton.

Je demande donc votre aide. Merci.

Bonjour

Devinette:

Vu le nombre impressionnant de sites sur lesquels tu as posé la même question, combien de bénévoles vont se creuser la tête inutilement?

J'espére que tu feras part à tous de la solution dès que tu la recevras

Cordialement

Bonjour Amadéus,

Effectivement j'ai posé cette question sur plusieurs forums, et je ne pense pas que ce soit interdit.

La raison principale étant que je ne trouve sur aucun de ces sites la réponse à ma question. Je pourrai donc peut être avoir une réponse plus rapide que je partagerai évidemment sur ces différents sites.

D'autant que je ne pense pas que cela fasse se creuser la tête à de nombreuses personnes, car je ne pense pas que ma question soit extrêmement difficile (sauf pour un néophyte tel que moi).

Maintenant, je ne force personne à répondre à ma question.

Merci.

En fait la solution n'est pas si simple,

j'ai regardé du coté des modules de classes, sans grand succès... J'ai par contre trouvé ce code que tu pourrais surement adapter :

Tu pourras dire que tu as trouvé un début de réponse ici

Bonjour Math,

Effectivement je suis tombé sur ce code il y a quelques minutes et j'étais en train d'essayer de le déchiffrer. Et oui, je débute alors c'est pas évident. J'ai essayé de m'en servir dans mon fichier, mais sans résultat.

J'arrive bien à créer un bouton sur ma feuille, mais pas à lui dire d'en ouvrir une autre quand on clique dessus.

Dans le code dont tu me parles, je ne comprends pas vraiment la fin :

'Paramètres pour la création de la macro:
    '(suppression contenu cellules)
    laMacro = "Sub CommandButton1_Click()" & vbCrLf
    laMacro = laMacro & "Cells.Clear" & vbCrLf
    laMacro = laMacro & "End Sub"

    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
        x = .CountOfLines + 1
        .InsertLines x, laMacro
    End With

Est ce que la ligne contenant Cells.Clear renvoie à une macro qui porte ce nom ? Si oui, doit on écrire cette macro sur la même feuille, sur une feuille de module ?

Dois je créer dans un module : Ouvrir_feuille_Modification

et lui entrer le code d'ouverture de la feuille ?

Je ne comprends pas non plus le dernier With...

Merci.

Les trois ligne débutant par lamacro définisse la macro à ajouter au code, dans l'exemple la macro suivante sera ajoutée:

Sub CommandButton1_Click()
Cells.Clear
End Sub

dans ton case tu devrais avoir plus ceci

laMacro = "Sub CommandButton1_Click()" & vbCrLf
laMacro = laMacro & "Sheets(" & Chr(34) & "Modification" & Chr(34) & ").Activate" & vbCrLf
laMacro = laMacro & "End Sub"

Je viens d'essayer tes lignes de code, sans résultat

Je n'ai pas d'erreur, mais le fait de cliquer sur le bouton ne fait rien.

Je ne comprends pas vraiment à quoi servent les chr(34)...je viens de voir que ça sert à remplacer des guillemets, mais je ne vois pas pourquoi on les met dans le cas présent.

Pour info, mon code entier sur cette page est :

Private Sub Chercher_Click()
Dim laMacro As String
Dim x As Integer
On Error Resume Next

Sheets(Range("B19").Value).Visible = 1
Application.ScreenUpdating = False
If Err <> 0 Then
   MsgBox "Pas d'invité avec ce nom dans la liste. Faites une autre recherche. Attention à l'orthographe et aux accents.", , "Message Erreur"

Else: Sheets(Range("B19").Value).Activate
Sheets("Recherche").Visible = 0
With ActiveSheet
.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
        , DisplayAsIcon:=False, Left:=183.75, Top:=119.25, Width:=169.5, _
        Height:=79.5).Select
.OLEObjects("CommandButton1").Object.Caption = "Modifier"
End With

laMacro = "Sub CommandButton1_Click()" & vbCrLf
laMacro = laMacro & "Sheets(" & Chr(34) & "Modification" & Chr(34) & ").Activate" & vbCrLf
laMacro = laMacro & "End Sub"

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
    x = .CountOfLines + 1
    .InsertLines x, laMacro
End With
Application.ScreenUpdating = True
End If
End Sub

Merci

Désolé mais ça fonctionne bien chez moi, tu dis ne pas avoir d'erreur et quand cliquant sur le nouveau bouton rien ne se passe. Va voir dans le code de la feuille où tu a ajouté le bouton si le code s'est bien inscrit. Tu devrais avoir

Sub CommandButton1_Click()
Sheets("Modification").Activate
End Sub

les deux chr(34) sont présent pour avoir des " qui entourent Modification. On peut aussi doubler les ""

laMacro = laMacro & "Sheets(""Modification"").Activate" & vbCrLf

on ne peut pas écrire "Sheets("Modification").Activate" dans le code. Vb va lire comme suit:

Sheets( comme du texte,

il ne comprendra pas Modification et

).Activate comme du texte

Les " servent en VB à marquer le début et la fin d'un chaine de texte

OK pour les guillemets. Merci de ton explication.

Dans mon fichier, le bouton se crée bien, mai sil n'y a pas de code de créé dans la page le concernant.

Merci.

remplace:

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
    x = .CountOfLines + 1
    .InsertLines x, laMacro
End With

par

With ThisWorkbook.VBProject.VBE.CodePanes(1).CodeModule
        x = .CountOfLines + 1
        .InsertLines x, laMacro
    End With

Merci.

Peux tu m'expliquer cette ligne ?

Avec ça et une autre ligne pour charger des références dans le dernier With :

.AddFromFile "C:\Program Files\Microsoft Office\Office\MSWORD8.OLB"

ça fonctionne maintenant, mais bizarrement. Je m'explique :

Si je commence avec mon fichier vide (pas d'invités) et que j'en crée un. Je recherche sa feuille. Il me crée bien un bouton "Modifier" sur sa feuille.

Par contre les lignes de code correspondant au bouton (pour afficher la feuille "Modification") s'écrit dans la page "Modification" au lieu de celle de l'invité.

Si je supprime ce code et le bouton dans la feuille de l'invité, et que je refais la recherche, ça fonctionne correctement (bouton sur la page de l'invité, et ouverture de "Modification" quand je clique).

Bizarre, non ?

La ligne charge une référence à Word, est-ce que tu utilise word dans ton projet? Sinon je ne vois pas à quoi ça sert. Pour ton autre problème, regarde si tu ne crée pas la feuille après avoir invoqué le code pour ajouter la macro. Il doit juste y avoir une erreur de l'ordre d'exécution de ton code

Je n'ai en effet pas de référence à Word, donc ligne a priori inutile. Confirmation, sans la ligne ça fait pareil...

Par contre j'ai beau relire le code, j'ai l'impression que c'est bien dans l'ordre.

J'ai ajouté des commentaires sur la ligne du code, pour le rendre un peu plus clair, et confirmer que c'est bien dans l'ordre.

Peux tu me confirmer que ça l'est bien ?

Pour la dernière ligne, je ne comprends vraiment pas à quoi elle sert...

Merci.

Private Sub Chercher_Click()
Dim laMacro As String
Dim x As Integer

Application.ScreenUpdating = False
On Error Resume Next

' Affiche l'onglet correspondant au nom de l'invité
Sheets(Range("B19").Value).Visible = 1

' Message d'erreur si pas d'invité avec ce nom
If Err <> 0 Then
   MsgBox "Pas d'invité avec ce nom dans la liste. Faites une autre recherche. Attention à l'orthographe et aux accents.", , "Message Erreur"

' Si pas d'erreur afficher l'onglet
Else: Sheets(Range("B19").Value).Activate

' Dans l'onglet de l'invité
With ActiveSheet
' Création d'un bouton
.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=183.75, Top:=119.25, Width:=169.5, _
Height:=79.5).Select
' Changer le nom d bouton
.OLEObjects("CommandButton1").Object.Caption = "Modifier"
End With

' Avec le clic du bouton
laMacro = "Sub CommandButton1_Click()" & vbCrLf
' Rendre visible la Feuil9
laMacro = laMacro & "Feuil9.Visible=1" & vbCrLf
' Activer la Feuil9
laMacro = laMacro & "Feuil9.Activate" & vbCrLf
laMacro = laMacro & "End Sub"

' ???
With ThisWorkbook.VBProject.VBE.CodePanes(1).CodeModule
x = .CountOfLines + 1
.InsertLines x, laMacro
End With

Application.ScreenUpdating = True
End If
End Sub

-- 13 Mai 2010, 01:10 --

Bonjour à tous,

J'ai réussi à obtenir ce que je voulais, à savoir un bouton créé automatiquement sur une page, pour en ouvrir une autre.

Le problème se situait dans la ligne :

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule

Il fallait remplacer .Name par .CodeName

Maintenant ça fonctionne.

Pour info, mon code en entier :

    Private Sub Chercher_Click()
    Dim laMacro As String
    Dim x As Integer
    On Error Resume Next

    Sheets(Range("B19").Value).Visible = 1
    Application.ScreenUpdating = False
    If Err <> 0 Then
       MsgBox "Pas d'invité avec ce nom dans la liste. Faites une autre recherche. Attention à l'orthographe et aux accents.", , "Message Erreur"

    Else: Sheets(Range("B19").Value).Activate
    With ActiveSheet
    .OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
            , DisplayAsIcon:=False, Left:=183.75, Top:=119.25, Width:=169.5, _
            Height:=79.5).Select
    .OLEObjects("CommandButton1").Object.Caption = "Modifier"

    End With

    laMacro = "Sub CommandButton1_Click()" & vbCrLf
    laMacro = laMacro & "Sheets(""Modification"").Visible=1" & vbCrLf
    laMacro = laMacro & "Sheets(""Modification"").Activate" & vbCrLf
    laMacro = laMacro & "End Sub"

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        x = .CountOfLines + 1
        .InsertLines x, laMacro
    End With

    Application.ScreenUpdating = True
    End If
    End Sub

Merci Math pour tes réponses et pour ton aide.