Créer un nouvelle feuille avec bouton

Version imprimable

Bonjour,

j'ai un code pour créer une feuille qui fonctionne très bien mais j'aimerais ajouter un bouton à la feuille et en ajoutant le code au bouton

Code de la feuille créer

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub creerFeuilles()
Dim curCell As Range
Set curCell = ThisWorkbook.Sheets("Accueil ").Range("B4")
While curCell.Value <> vbNullString
    ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curCell.Value & " " & curCell.Offset(0, 1).Value
    ThisWorkbook.Sheets("Accueil ").Hyperlinks.Add Anchor:=curCell.Offset(0, 2), Address:="", SubAddress:= _
        "'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!A1", TextToDisplay:="Acces à laFeuille"
    Set curCell = curCell.Offset(1, 0)
Wend
ThisWorkbook.Sheets("Accueil ").Select
 
 'Récuperer le nom de l'onglet
 Dim f As Worksheet
     For Each f In Worksheets
     If f.Name <> "Accueil" Then
     f.Range("K1") = f.Name
 
         With f.Range("k1")
            ' .Borders.Weight = 3
             .Font.Bold = True
             .Font.Size = 18
             .Font.Italic = True
             .Font.Name = "Arial"
         End With
         End If
     Next
 
End Sub

Code du bouton

Code:

1
2
3
Sub Save ()
Application.DisplayAlerts = False
ActiveWorkBook.Save

Je vous remercie d'avance

Cordialement

Max

23/02/2015, 17h56
Kimy_Ire

Bonjour Max,

Je pense que l'enregistreur de macro peut t'être très utile pour ce que tu cherches ! :ccool:

Cordialement,
Kimy
23/02/2015, 18h00
apdf1

Bonsoir Kimy

Non j'ai essayé je ne suis pas arriver!

Cordialement

Max

Hum...

Avec l'enregistreur :

Code:

1
2
3
4
5
6
7
8
9
10
Sub Macro1()
'
' Macro1 Macro
'
 
'
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Buttons.Add(84.75, 22.5, 105.75, 25.5).Select
    Selection.OnAction = "mamacro"
End Sub

Avec 2 modif' parce que je suis maniaque (et encore... je garde le .Select dont j'ai horreur) :

Code:

1
2
3
4
5
6
7
Sub apdf1()
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    With Worksheets(Worksheets.Count)
        .Buttons.Add(84.75, 22.5, 105.75, 25.5).Select
    End With
    Selection.OnAction = "mamacro"
End Sub

Ca fonctionne ! :ccool:

Cordialement,
Kimy

re,

Je te remercie de ton intervention rapide.

J'ai du faire une boulette, j'ai un message d'erreur
Impossible de définir la propriété OnAction de la classe Button j'ai fait ceci.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub creerFeuilles()
Dim curCell As Range
Set curCell = ThisWorkbook.Sheets("Accueil ").Range("B4")
While curCell.Value <> vbNullString
    ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curCell.Value & " " & curCell.Offset(0, 1).Value
    ThisWorkbook.Sheets("Accueil ").Hyperlinks.Add Anchor:=curCell.Offset(0, 2), Address:="", SubAddress:= _
        "'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!A1", TextToDisplay:="Acces à laFeuille"
    Set curCell = curCell.Offset(1, 0)
Wend
 
 
 
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    With Worksheets(Worksheets.Count)
        .Buttons.Add(84.75, 22.5, 105.75, 25.5).Select
    End With
    Selection.OnAction = Application.DisplayAlerts = False
ActiveWorkBook.Save
 
 
 
 
ThisWorkbook.Sheets("Accueil ").Select
 
 'Récuperer le nom de l'onglet
 Dim f As Worksheet
     For Each f In Worksheets
     If f.Name <> "Accueil" Then
     f.Range("K1") = f.Name
 
         With f.Range("k1")
            ' .Borders.Weight = 3
             .Font.Bold = True
             .Font.Size = 18
             .Font.Italic = True
             .Font.Name = "Arial"
         End With
         End If
     Next
 
End Sub

Cordialement

Max

23/02/2015, 18h42
kiki29

Salut, jette un œil ici : Visual Basic Editor ?

Voici en "mieux" formalisé :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Dim curCell As Range
 
With ThisWorkbook
    Set curCell = .Sheets("Accueil").Range("B4")
    While curCell.Value <> vbNullString
        .Sheets.Add After:=.Sheets(.Sheets.Count)
        .Sheets(.Sheets.Count).Name = curCell.Value & " " & curCell.Offset(0, 1).Value
'        .Sheets("Accueil").Hyperlinks.Add Anchor:=curCell.Offset(0, 2), Address:="", SubAddress:= _
'            "'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!A1", TextToDisplay:="Acces à laFeuille"
        Set curCell = curCell.Offset(1, 0)
        With .Worksheets(.Worksheets.Count)
            .Buttons.Add(84.75, 22.5, 105.75, 25.5).Select
        End With
        Selection.OnAction = "mamacro"
    Wend
End With

Ton problème était là : Selection.OnAction = Application.DisplayAlerts = False. Ya du Suppr en trop je pense. :aie:

Cordialement,
Kimy

23/02/2015, 18h54
apdf1

Re,

Que marque tu a la place de "mamacro"

Cordialement

Max
25/02/2015, 11h31
Kimy_Ire

Euh?! :koi:
Tu veux placer un bouton avec une macro associée ?

C'est le nom de la macro en question...