Creer une nouvelle feuille et Attribuer un titre

cpeens · 23 Août 2010

Bonjour à tous je reviens vers vous pour un problème que je n'arrive pas pas à résoudre

Je recherche à créer une macro qui me permettrais de créer une Feuille supplémentaire en la renommant de façon logique.

à ce jour mes Feuilles sont tous renommer ainsi :

EX1
EX2
EX3

je souhaiterais que la prochaine feuille soit créer par macro et renommer EX4

puis EX5 la prochaine ect ....

je souhaiterais également dans la mesure du possible pouvoir choisir non pas le NOM mais le titre de la Feuille qui apparaitras en cellule F6

J'ai mis un exemple de présentation il y à également un module car j'ai essayer de créer ma macro en utilisant l'assistant macro mais sa n'a pas vraiment donné grand chose merci d'avance à tous ceux qui pourront m'aider

Guest · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Bonjour,

Dans un module général:

Code:

'Retourne le prochaine numéro de feuille ou 0 si non trouvé
[COLOR=blue]Function[/COLOR] GetNewX() [COLOR=blue]As[/COLOR] [COLOR=blue]Integer[/COLOR]
    [COLOR=blue]Dim[/COLOR] sh [COLOR=blue]As[/COLOR] Worksheet
    [COLOR=blue]Dim[/COLOR] x [COLOR=blue]As[/COLOR] [COLOR=blue]Integer[/COLOR]
    [COLOR=blue]Dim[/COLOR] Nom [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR]
    x = -1
    [COLOR=blue]For[/COLOR] [COLOR=blue]Each[/COLOR] sh [COLOR=blue]In[/COLOR] Worksheets()
        Nom = Replace(sh.Name, [I]"EX"[/I], [I]""[/I])
        [COLOR=blue]If[/COLOR] Nom <> sh.Name [COLOR=blue]And[/COLOR] IsNumeric(Nom) [COLOR=blue]Then[/COLOR]
            [COLOR=blue]If[/COLOR] Val(Nom) > 0 [COLOR=blue]And[/COLOR] Val(Nom) > x [COLOR=blue]Then[/COLOR] x = Val(Nom)
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]Next[/COLOR] sh
    GetNewX = x + 1
[COLOR=blue]End[/COLOR] [COLOR=blue]Function[/COLOR]
[COLOR=blue]Sub[/COLOR] CreateNewSheet()
    [COLOR=blue]Dim[/COLOR] x [COLOR=blue]As[/COLOR] [COLOR=blue]Integer[/COLOR]
    x = GetNewX()
    Worksheets([I]"EX"[/I] & x - 1).Copy After:=Worksheets(Worksheets.Count)
    [COLOR=blue]If[/COLOR] x > 0 [COLOR=blue]Then[/COLOR] ActiveSheet.Name = [I]"Ex"[/I] & x
    UserForm1.Show
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

Dans le code du UserForm;

Code:

[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] CommandButton1_Click()
    [COLOR=blue]If[/COLOR] Trim(TextBox1.Text) <> [I]""[/I] [COLOR=blue]And[/COLOR] TextBox1.Text <> .Range([I]"F6"[/I]) [COLOR=blue]Then[/COLOR] .Range([I]"F6"[/I]) = TextBox1.Text
    [COLOR=blue]If[/COLOR] Trim(TextBox2.Text) <> [I]""[/I] [COLOR=blue]And[/COLOR] TextBox2.Text <> ActiveSheet.Name [COLOR=blue]Then[/COLOR]
        [COLOR=blue]On[/COLOR] [COLOR=blue]Error[/COLOR] [COLOR=blue]Resume[/COLOR] [COLOR=blue]Next[/COLOR]
        ActiveSheet.Name = TextBox2.Text
        [COLOR=blue]If[/COLOR] Err.Number > 0 [COLOR=blue]Then[/COLOR]
            MsgBox Err.Description, vbExclamation, [I]"Changement d'un nom de feuille"[/I]
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] UserForm_Initialize()
    [COLOR=blue]With[/COLOR] ActiveSheet
        TextBox2 = .Name
        TextBox1 = .Range([I]"F6"[/I])
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

Utilisation: appeler la procédure CreateNewSheet

Par contre se serait bien de déterminer si le nom doit commencé par "Ex" ou "EX"?

A+

cpeens · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Bonjour Hasco et merci pour ton aide j'ai essayer de faire comme tu ma dis j'ai modifier tous les Ex en EX inserer les module mais j'ai une erreur (voir le FJ) quelle est la raison svp

merci

Guest · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Bonjour,

1- dire: ça marche pas, y'a une erreur sans donner la ligne et la description de l'erreur, nous oblige à faire des manips à ta place. Et ça j'aime pas.

2- la seule erreur rencontrée, et le texte du message d'erreur est explicite est due au fait que dans la précipitation du copier/coller tu a laissé 'End Sub' en trop dans le module

3- si tu changes "Ex" Par "EX3 changes aussi dans la macro.

A+

cpeens · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Merci Mr pour vos remarques j'ai jamais dit à personne de rechercher les erreur à ma place avant d'affirmer ce genre de chose tu devrais réflexible un peu il est vrais que j'ai omis un end sub mais j'ai pas la science infuse et je débute en VBA j'ai pas vos réflex maintenant j'ai bien regarder de partout et j'ai toujours des erreurs référence incorrect ou non qualifier je me penche dessus je tiendrais au courant merci tout de même pour le temps que m'à consacrer

Guest · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Re,

Tout doux cpeens, je disais que je n'aime pas. C'est tout.

Tu ne dis toujours pas à quel endroit précis tu as ces erreurs.

A+

cpeens · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Re bonjour dsl

L'erreur se trouvent dans

Code:

Private Sub CommandButton1_Click()
    If Trim(TextBox1.Text) <> "" And TextBox1.Text <> .[COLOR="RoyalBlue"]Range[/COLOR]("F6") Then .Range("F6") = TextBox1.Text
    If Trim(TextBox2.Text) <> "" And TextBox2.Text <> ActiveSheet.Name Then
        On Error Resume Next
        ActiveSheet.Name = TextBox2.Text
        If Err.Number > 0 Then
            MsgBox Err.Description, vbExclamation, "Changement d'un nom de feuille"
        End If
    End If
End Sub

il me surligne .Range

erreur de compilation
référence incorrect ou non qualifier

je pensais donc c'etait dût à F6 car le titre est en F1 j'ai donc modifier et sa me donne exactement pareil j'ai donc essayer comme ceci pour isoler la ligne à probleme

Code:

Private Sub CommandButton1_Click()
   [COLOR="RoyalBlue"] 'If Trim(TextBox1.Text) <> "" And TextBox1.Text <> .Range("F6") Then [/COLOR].Range("F6") = TextBox1.Text
    If Trim(TextBox2.Text) <> "" And TextBox2.Text <> ActiveSheet.Name Then
        On Error Resume Next
        ActiveSheet.Name = TextBox2.Text
        If Err.Number > 0 Then
            MsgBox Err.Description, vbExclamation, "Changement d'un nom de feuille"
        End If
    End If
End Sub

et la il me renomme la Feuille sans m'en ajouter une

je sais pas si j'étaie clair

merci

Guest · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

RE,

On travaille sur la feuille active. Il manquait juste ActiveSheet.

Code:

Private Sub CommandButton1_Click()
    If Trim(TextBox1.Text) <> "" And TextBox1.Text <> [COLOR=blue][B]ActiveSheet[/B][/COLOR].Range("F6") Then [COLOR=blue][B]ActiveSheet[/B][/COLOR].Range("F6") = TextBox1.Text
    If Trim(TextBox2.Text) <> "" And TextBox2.Text <> ActiveSheet.Name Then
        On Error Resume Next
        ActiveSheet.Name = TextBox2.Text
        If Err.Number > 0 Then
            MsgBox Err.Description, vbExclamation, "Changement d'un nom de feuille"
        End If
    End If
End Sub

Pour le F6: je te rapelle ta demande du post #1:

le titre de la Feuille qui apparaitras en cellule F6

Pour le 3ème point, ta demande n'étant pas suffisament explicite, j'avais donc décidé d'organiser les choses comme ceci:

1- créer une fonction qui retourne le numéro de la future feuille
2- créer un macro qui créee une nouvelle feuille et qui lance le userform sur cette feuille.
3- dans le userfor afficher le nom de la feuille active.
4- Sur validation:
l'utilisateur a saisit un titre? on l'inscrit dans la cellule
l'utilisateur a changé le nom de feuille proposé? on change le nom de la feuille par celui-rentré dans le textBox.

Maintenant, si cela ne va pas. Tu peux t'aider de la fonction GetNewX et voir comment tu peux modifier les chose selon ton gré.

Pour ma part je pense avoir répondu à la demande du post #1

A+

cpeens · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Merci Hasco j'ai modifier le code comme ceci et cela fonctionne parfaitement comme je souhaitais

Code:

Private Sub CommandButton1_Click()
Module1.CreateNewSheet
   If Trim(TextBox1.Text) <> "" And TextBox1.Text <> ActiveSheet.Range("F1") Then ActiveSheet.Range("F1") = TextBox1.Text
   ' If Trim(TextBox2.Text) <> "" And TextBox2.Text <> ActiveSheet.Name Then
     '   On Error Resume Next
      '  ActiveSheet.Name = TextBox2.Text
      '  If Err.Number > 0 Then
       'MsgBox Err.Description, vbExclamation, "Changement d'un nom de feuille"
       ' End If
   'End If
End Sub

Private Sub UserForm_Initialize()
    With ActiveSheet
        TextBox2 = .Name
        'TextBox1 = .Range("F1")
    End With
End Sub

merci encore pour le temps passer à m'aider à bientôt

Guest · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Re,

Bravo.

A+

cpeens · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Re je viens encore vous embêter un petit peu depuis cette après-midi j'essaie de faire en sorte pour que ce soit la future feuille qui s'affiche dans la textbox2 au lieu de la dernière Feuille du classeur mais je n'arrive pas à arrivé à mes fins en utilisant le même code que celui ci

Private Sub UserForm_Initialize()
With ActiveSheet
TextBox2 = .Name
'TextBox1 = .Range("F1")
End With
End Sub

Code:

et

Code:

'Retourne le prochaine numéro de feuille ou 0 si non trouvé
Function GetNewX() As Integer
    Dim sh As Worksheet
    Dim x As Integer
    Dim Nom As String
    x = -1
    For Each sh In Worksheets()
        Nom = Replace(sh.Name, "EX", "")
        If Nom <> sh.Name And IsNumeric(Nom) Then
            If Val(Nom) > 0 And Val(Nom) > x Then x = Val(Nom)
        End If
    Next sh
    GetNewX = x + 1
End Function
Sub CreateNewSheet()
    Dim x As Integer
    x = GetNewX()
    Worksheets("EX" & x - 1).Copy After:=Worksheets(Worksheets.Count)
    If x > 0 Then ActiveSheet.Name = "EX" & x
    UserForm1.Show
End Sub

quelqu'un aurait il une idée SVP merci

Guest · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

RE bonjour,

donc tu veux:

Afficher le userform avec le nom de la future feuille et ne la créer que sur validation:

Remplace:

Code:

Sub CreateNewSheet()
    Dim x As Integer
    x = GetNewX()
    Worksheets("EX" & x - 1).Copy After:=Worksheets(Worksheets.Count)
    If x > 0 Then ActiveSheet.Name = "EX" & x
    UserForm1.Show
End Sub

Par:

Code:

Sub CreateNewSheet()
    Dim x As Integer
    x = GetNewX()
    UserForm1.TextBox2 = "EX" & X
    UserForm1.Show
End Sub

Enlève ce qu'il y a dans UserForm_Initialize.

Et dans le CommandButton1_Click mets :

Code:

Worksheets("EX1").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = TextBox2

A+

Guest · 23 Août 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Re,

En changeant légèrement les choses pour qu'elle se fassent dans le userform uniquement, voici son code complet

Code:

[COLOR=BLUE]Dim[/COLOR] x [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]Integer[/COLOR]
[COLOR=BLUE]Private[/COLOR] [COLOR=BLUE]Sub[/COLOR] CommandButton1_Click()
    [COLOR=BLUE]If[/COLOR] Trim(TextBox2) <> [i]""[/i] [COLOR=BLUE]Then[/COLOR]
        [COLOR=BLUE]If[/COLOR] x = -1 [COLOR=BLUE]Then[/COLOR]
            MsgBox [i]"Aucune feuille 'EX' n'a été trouvée"[/i], vbExclamation, [i]"Création feuille"[/i]
        [COLOR=BLUE]Else[/COLOR]
            Worksheets([i]"EX"[/i] & x).Copy After:=Worksheets(Worksheets.Count)
            [COLOR=BLUE]If[/COLOR] x > 0 [COLOR=BLUE]Then[/COLOR] ActiveSheet.Name = [i]"EX"[/i] & x + 1
            [COLOR=BLUE]If[/COLOR] Trim(TextBox1) <> [i]""[/i] [COLOR=BLUE]Then[/COLOR] Range([i]"F1"[/i]) = TextBox1
        [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
    [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]
[COLOR=BLUE]Function[/COLOR] GetLastX() [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]Integer[/COLOR]
    [COLOR=BLUE]Dim[/COLOR] sh [COLOR=BLUE]As[/COLOR] Worksheet
    [COLOR=BLUE]Dim[/COLOR] LastX [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]Integer[/COLOR]
    [COLOR=BLUE]Dim[/COLOR] Nom [COLOR=BLUE]As[/COLOR] [COLOR=BLUE]String[/COLOR]
    LastX = -1
    [COLOR=BLUE]For[/COLOR] [COLOR=BLUE]Each[/COLOR] sh [COLOR=BLUE]In[/COLOR] Worksheets()
        Nom = Replace(UCase(sh.Name), [i]"EX"[/i], [i]""[/i])
        [COLOR=BLUE]If[/COLOR] Nom <> sh.Name [COLOR=BLUE]And[/COLOR] IsNumeric(Nom) [COLOR=BLUE]Then[/COLOR]
            [COLOR=BLUE]If[/COLOR] Val(Nom) > 0 [COLOR=BLUE]And[/COLOR] Val(Nom) > LastX [COLOR=BLUE]Then[/COLOR] LastX = Val(Nom)
        [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
    [COLOR=BLUE]Next[/COLOR] sh
    GetLastX = LastX
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Function[/COLOR]
[COLOR=BLUE]Sub[/COLOR] CreateNewSheet()
    Worksheets([i]"EX"[/i] & x).Copy After:=Worksheets(Worksheets.Count)
    [COLOR=BLUE]If[/COLOR] x > 0 [COLOR=BLUE]Then[/COLOR] ActiveSheet.Name = [i]"Ex"[/i] & x + 1
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]
[COLOR=BLUE]Private[/COLOR] [COLOR=BLUE]Sub[/COLOR] UserForm_Initialize()
    x = GetLastX()
    TextBox2 = [i]"EX"[/i] & x + 1
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]

A+

cpeens · 1 Septembre 2010

Re : Creer une nouvelle feuille et Attribuer un titre

Bonjour à toi hasco et merci pour tes nouvelle modification je m'en testé sa de suite à bientot

cpeens · 2 Septembre 2010

Re : Creer une nouvelle feuille et Attribuer un titre

bonjour dans le code gentillement proposer par hasco me porte problème

quand je valide j'ai une erreur avec la ligne suivante surligner

Code:

Dim x As Integer

    If Trim(TextBox4) <> "" Then
        If x = -1 Then
            MsgBox "Aucune feuille 'FORMATION' n'a été trouvée", vbExclamation, "Création feuille"
        Else
           [COLOR="Red"] Worksheets("FORMATION" & x).Copy After:=Worksheets(Worksheets.Count)[/COLOR]
            If x > 0 Then ActiveSheet.Name = "FORMATION" & x + 1
            If Trim(TextBox3) <> "" Then Range("F1") = TextBox3
        End If
    End If

avec comme message l'indice n'appartiens pas à la sélection

pouvez vous m'aider svp a localiser l'erreur

Creer une nouvelle feuille et Attribuer un titre

cpeens

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

cpeens

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

cpeens

XLDnaute Occasionnel

Guest

Guest

cpeens

XLDnaute Occasionnel

Guest

Guest

cpeens

XLDnaute Occasionnel

Guest

Guest

cpeens

XLDnaute Occasionnel

Guest

Guest

Guest

Guest

cpeens

XLDnaute Occasionnel

cpeens

XLDnaute Occasionnel

Discussions similaires

Creer une nouvelle feuille et Attribuer un titre

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

XLDnaute Occasionnel

Guest

Guest

XLDnaute Occasionnel

Guest

Guest

XLDnaute Occasionnel

Guest

Guest

XLDnaute Occasionnel

Guest

Guest

Guest

Guest

XLDnaute Occasionnel

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency