Macro qui créé un bouton qui enverra à l'onglet choisie

Bonjour tous le monde;

J'espère que se sera assez clair, sinon redemandez moi

J'aimerai trouver une macro qui se lance quand je clique droit sur une cellule d'une colonne et qui va me créer un bouton dans cette cellule, elle me demandera de sélectionner un onglet puis imputera au bouton la macro qui m'enverra sur cet onglet par la suite.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range("S:S")) Is Nothing Then

'MsgBox "Click on " & Target.Address (mon action que je n'ai pas encore trouver)
Cancel = True
End If
End Sub

Ce code me permet de lancer la macro quand je clique droit mais je n'arrive pas à trouver quel code pourrai me permettre de choisir un des onglet de ma feuille

Si qqn à une idée c'est avec très grand plaisir!!

Merci d'avance

Salut le Fofo,

Tu a pas mal de solution pour bouger d'une feuille à l'autre, et vue que j'ai pas saisie ta demande tu trouvera ci-joint un fichier regroupant 3 propositions !

Salut Juice,

Merci de ta réponse, mais du coup j'ai avancer sur ma demande et j'ai a peu près réussi à faire tout ce que je voulais sauf un truc :

Je cherche une macro qui s'appliquera quand je cliquerai sur un des boutons de l'userform, j'ai trouver cette macro qui me créer bien un bouton ou il faut mais pas avec le bon nom (celui de la combobox) ni avec le bon codage :

Private Sub Bouton_Crear_Click()
Dim Obj As Object
Dim Code As String
ActiveCell.Select
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=ActiveCell.Width, _
Height:=ActiveCell.Height)
Obj.Name = List_Der_Ong.Text

ActiveSheet.OLEObjects(1).Object.Caption = "Ficha Sup" 'Le texte de la macro
Code = "Sub " & Liste_Der_Ong.Text & "_Click()" & vbCrLf
Code = "Sheets(" & Liste_Der_Ong.Text & ").Select" & vbCrLf
Code = "End Sub" 'Ajoute la macro en fin de module feuille
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, Code
End With
End Sub

List_Der_Ong est le nom de ma combobox qui est une liste déroulante qui permet à l'utilisateur de sélectionner un nom d'onglet.

En fait quand je clique sur le bouton, j'aimerai qu'il me créé un bouton dans la cellule active (Ca la formule le fait bien) , le nom du bouton serait le choix de la combobox et elle associerai au bouton une macro qui permettrai d'ouvrir l'onglet sélectionner dans la combobox.

J'espère que j'ai été assez claire cette fois

J'espère que tu pourras m'aider

S'il y a qqch que tu ne comprends pas dis moi

Un grand merci

Yo Pintura,

Je procéderais ainsi :

1- Dans ton module tu déclare une variable Public :

Option Explicit
Public Onglet As String

2- Tu créé une macro qui ce sers de cette variable pour aller à l'onglet voulu :

Sub Changement_de_feuille()
Sheets(Onglet).Select
End Sub

3- Pour donner une valeur à ta variable "Onglet", tu va dans ton UserForm :

Private Sub ComboBox_Change()
Onglet = CStr(ComboBox.Value)
ActiveSheet.Shapes.Range(Array("Button 1")).Select '!!Le nom de ton boutton peux ne pas être le même!!
Selection.Characters.Text = Onglet 'Le boutton selectionner changera automatiquement de nom en fonction du choix dans ton Combobox
Selection.OnAction = "Changement_de_feuille" 'Tu affecte ta macro à ton Button1
End Sub

Et voilà!

Quand ta ComboBox change de valeur, le nom de ton Boutton aussi, et puisque le nom de ton onglet est dans une variable Public, la macro fonctionnera quand tu cliquera dessus ;D

Dans l'attente de ton retour

Bonjour Juice,

Merci de ta réponse.

Ca aurait été une super solution mais le soucis c'est que je veux créer plusieurs bouton différent et que chacun de ses boutons envoie vers un onglet défini qui ne changera plus une fois créer.

En fait j'ai un tableau avec plein de produit que j'entre en fonction de l'utilisation et chaque produit à une fiche à lui en onglet dans le classeur et je voudrais que la personne en cliquant sur la case correspondant au "lien des fiches" puissent y créer un bouton qui l'enverra à l'onglet quelle aura choisie (la fiche en question) de facon définitive puis quelle puissent refaire ca pour le produit de la ligne d'en dessous sans que ça change le lien qu'elle a fait pour le bouton du dessus.

C'est vrai que ce n'était pas très clair dsl

Pintura

Décidément sa aurait été plus simple avec un fichier dès le début :p

Le fichier que je te joint est ma "dernière tentative" pour t'aider, car je crois pas que je puisse faire mieux que sa x)

En gros, voici ce que fais la macro pas-à-pas :

1° Créer un nouveau module pour créer des macros

2° Liste tes onglets en colonne A

3° Commence une boucle sur le nombre de valeur que tu a en colonne A qui va :

• Créer un bouton de contrôle de formulaire pour chaque valeur
• Créer une macro pour chaque valeur
• Rattacher à chaque bouton de contrôle de formulaire une macro ainsi qu'un onglet

Je te raconte pas comment j'ai galérer pour mettre sa au point xDDD

Pour pouvoir faire fonctionner cette macro tu dois impérativement activer la référence "Microsoft Visual basic For Application Extensibility 5.3" et activer le paramètre de confidentialité '"Accès approuvé au modèle du projet VBA" !

Et puisque tu dois adapter cette macro à ton propre fichier, fais attention aux références comme :

Les numéros de colonne indiquées

Columns("A:A").Select
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
'ect...

Les balises indiqué pour l'insertion des boutons de contrôle de formulaire

ActiveSheet.Buttons.Add(60, Ligne, 59.25, 14.25).Select
'ActiveSheet.Buttons.Add(Colonne, Ligne, Largeur, Hauteur)
'Colonne = 60 pour une largeur de colonne non modifié
'Ligne = 15 pour une hauteur de ligne non modifié
'Largeur = Largeur de la cellule
'Hauteur = Hauteur de la cellule

le nom de ton fichier :

Set Wb = Workbooks("Pour Pintura2.xlsm")
If VerifierExistenceModule(Workbooks("Pour Pintura2.xlsm")

Etc... Etc...

Bon bah voilà

J'espère que ce fichier te conviendra !

Pour ma pars il fonctionne impec'

NB: Pour ceux qui veulent juste le code :

Option Explicit
Public DernLigne As Long
Public Feuil As String

'Nécéssite d'activer la référence
'"Microsoft Visual basic For Application Extensibility 5.3"
'Nécéssite d'activer le paramètre
'"Accès approuvé au modèle du projet VBA"
'
Function VerifierExistenceModule(Wb As Workbook, Mdl As String) As Boolean
    Dim VBComp As VBComponent

    On Error Resume Next
    Set VBComp = Wb.VBProject.VBComponents(Mdl)

    If VBComp Is Nothing Then
        VerifierExistenceModule = False
        Else
        VerifierExistenceModule = True
    End If
End Function

Sub Create_Button()
' Source : http://www.lecfomasque.com/excel-macro-noms-onglets/
' Source : https://silkyroad.developpez.com/VBA/VisualBasicEditor/
' Source : De Juice pour Pintura

Dim Onglet As String
Dim Ligne As String
Dim Wb As Workbook
Dim VBComp As VBComponent
Dim X As Integer

If VerifierExistenceModule(Workbooks("Pour Pintura2.xlsm"), "Module_Feuille") = True Then
With ThisWorkbook.VBProject.VBComponents 'Supprime l'ancien Module_Feuille si il existe
        .Remove .Item("Module_Feuille")
End With
End If

Set Wb = Workbooks("Pour Pintura2.xlsm") 'Definit le classeur cible
Set VBComp = Wb.VBProject.VBComponents.Add(1) 'ajoute un module standard
VBComp.Name = "Module_Feuille" 'Renomme le module

Columns("A:A").Select
Selection.EntireColumn.Hidden = False 'retire le masque sur la colonne A
Selection.ClearContents 'remise à blanc des cellules colonne A

Dim i As Integer 'Liste les onglets présent dans le classeur en colonne A à partir de la Cell(1,1)
Range("A1").Select
For i = 1 To Sheets.Count
ActiveCell.Value = Sheets(i).Name
ActiveCell.Offset(1, 0).Select
Next i

DernLigne = Range("A" & Rows.Count).End(xlUp).Row

While DernLigne <> 0 'Tant que DernLigne est différent de zéro

With VBComp.CodeModule 'Ajoute une macro
        X = .CountOfLines
        .InsertLines X + 1, "Sub Go_sur_feuille" & DernLigne & "()"
        .InsertLines X + 2, "Feuil = Range(""A" & DernLigne & """)"
        .InsertLines X + 3, "Sheets(Feuil).Select"
        .InsertLines X + 4, "End Sub"
End With

Onglet = Range("A" & DernLigne).Value 'La variable onglet prend les noms en colonne A

If DernLigne = 1 Then 'Pour le dernier onglet à entrer
Ligne = 0
Else
Ligne = DernLigne * 15 - 15
End If

ActiveSheet.Buttons.Add(60, Ligne, 59.25, 14.25).Select
'ActiveSheet.Buttons.Add(Colonne, Ligne, Largeur, Hauteur)
'Colonne = 60 pour une largeur de colonne non modifié
'Ligne = 15 pour une hauteur de ligne non modifié
'Largeur = Largeur de la cellule
'Hauteur = Hauteur de la cellule

Selection.Caption = Onglet 'On donne le nom de l'onglet au bouton
Selection.OnAction = "Go_sur_feuille" & DernLigne 'On y affecte la macro correspondante
DernLigne = DernLigne - 1 'on retire une valeur à DernLigne
Wend

Columns("A:A").Select
Selection.EntireColumn.Hidden = True 'remet le masque sur la colonne A

End Sub

Salut Juice,

Alors ton code est super mais je n'en demandé pas tant, en effet c'est ma faute je ne voulais pas mettre mon fichier parce qu'il y avait des valeur confidentielle mais je les ai enlever pour en mettre une copie qui sais ça pourra toujours servir a qqn.

Je voulais juste que tu me dises quest_ce qui clochait dans ma macro :

Private Sub Bouton_Crear_Click()
Dim Obj As Object
Dim Code As String
ActiveCell.Select
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=ActiveCell.Width, _
Height:=ActiveCell.Height)
Obj.Name = List_Der_Ong.Text

ActiveSheet.OLEObjects(1).Object.Caption = "Ficha Sup" 'Le texte de la macro
Code = "Sub " & Liste_Der_Ong.Text & "_Click()" & vbCrLf
Code = "Sheets(" & Liste_Der_Ong.Text & ").Select" & vbCrLf
Code = "End Sub" 'Ajoute la macro en fin de module feuille
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, Code
End With
End Sub

Et qui faisais que le code ne se copiait pas dans VBA et qu'il ne se raccordait pas au bouton créer. Je vais me débrouiller autrement.

Merci infiniment de m'avoir répondu

Un grand merci à tous ceux qui m'ont aidé

Je mets résolu