• Initiateur de la discussion Initiateur de la discussion gds35
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

gds35

XLDnaute Impliqué
Bjr à tous , Bon WE j'ai qq peu progresser en VBA mais pas encore assez pour vous demander de m'aider à résoudre mon PB....... Voilà
J'ai crée avec du mal un code qui effectue : - Création d'un UF , Incorporation d'une Liste deroulante dont la liste liste de contrôle demarre en A250 et le classeur a 25 Feuilles. Dans ce code je peux créer une nelle feuille,en modifiant la liste de contrôle et incorporer le Nom de l'onglet. Maintenant passons au HIC !!!! (Ps les feuilles s'appellent Feuil1 ... Feuil25)
Je cherche a creer 2 nx codes associes à 2 boutons qui 1/ me permet de modifier à la fois le nom de l'onglet et de ma liste de controle et 2/ un bouton qui me permette de supprimer la feuille et supprimer la ligne correspondante ds la liste de contrôle. Je n'ai + beaucoup de cheveux , je me les arrache sans trouver la solution a mon Pb Merci de m'aider à les conserver !!!!! vs êtes tellement super sur ce site que je suis persuadé avoir une reponse. Encore Bon WE . Mon Mail gds35@free.fr . Merci a tous
 
Re : Nom de Feuilles

Bonjour gds, bonjour le forum,

Il manque des indications pour que nous puissions t'aider rapidement. Quel est le nom de l'onglet qui contient la liste ? Quand tu vas modifier un nom d'onglet, sera-t-il obligatoirement actif ou pas ? Pourquoi pas un fichier exemple basé sur ton fichier que j'imagine volumineux. Juste quelques onglets avec un minimum de données et l'UF. Les réponses seront à coup sûr beaucoup mieux ciblées.
 
Re : Nom de Feuilles

Salut merci de m'aider ma liste de contrôle est ds l'onglet MENU et ce que désirerais faire c'est par eX Nom actuel de la Feuille Feuil22 et voudrais transformer onglet Feuill22 en TOTO et ds la liste de controle remplacer la cellule Feuill22 par TOTO. Je ne sais si je si des + clair mais en tout cas vs etes super sympa de m'aider A+ Cordialement GéGé
 
Re : Nom de Feuilles

Merci Staple , vs êtes vraiment tous genial sur ce site . Voila mon code de Creation . Je me répete impossible de modifier Nom de Feuille à la fois ds la liste de contrôle et le nom de l'onglet , pas + de supprimer une feuille sélectionnée et sup de la ligne ds la liste de controle
Sub AjouterFeuille()
'
' AjouterFeuille Macro
' Macro enregistrée le 17/09/2007 par GDS35
'
Dim Sh As Worksheet
Dim Reponse As String
Dim MonNom As String
Dim BonNom As Boolean
Dim LeString
LeString = ":\/?*[]"

Do
BonNom = True
Reponse = InputBox("NOM de votre" _
+ vbCrLf + "NOUVELLE FEUILLE dans le CLASSEUR?", _
"NOM FEUILLE ??? ", MonNom)
If Reponse <> "" Then
'Vérifier que le nom n'existe pas déja
For a = 1 To ActiveWorkbook.Worksheets.Count
If UCase(Reponse) = UCase(Worksheets(a).Name) Then
supp = MsgBox( _
"NOM de FEUILLE DEJA EXISTANT," _
+ vbCrLf + vbCrLf + _
"LE REMPLACER ??.", vbYesNo + vbOKOnly, _
"NOM DEJA EXISTANT")
If supp = vbYes Then
Application.DisplayAlerts = False
Worksheets(Reponse).Delete
Application.DisplayAlerts = True
Exit For
Else
BonNom = False
MonNom = Reponse
Exit For
End If
End If
Next

'Vérifier que le nombre de caracteres du nom ne dépassent 31...
If Len(Reponse) > 31 Then
MsgBox "LE NOM EST TROP LONG !!!! (" & _
Len(Reponse) & ") IL DEPASSE" _
+ vbCrLf + " 31 CARACTERES"
BonNom = False
MonNom = Reponse
End If

'Vérifier l'emploi de caracteres interdits...dans le nom
For a = 1 To Len(LeString)
If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0 Then
MsgBox "CE (CES) CARACTERES " & _
LeString & " NE SONT PAS AUTORISE(S)" _
+ vbCrLf + "DANS LE NOM D'UNE FEUILLE", _
vbCritical + vbOKOnly, "CARACTERE INTERDITS !!!!!!!"
BonNom = False
MonNom = Reponse
Exit For
End If
Next
Else
Exit Sub
End If
Loop Until BonNom = True

Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sh.Name = Reponse
'mise en page VBA avec l'objet PageSetup
ActiveSheet.DisplayPageBreaks = False
With ActiveSheet.PageSetup
.LeftHeader = "" 'AUCUN ENTETE DE PAGE A GAUCHE
.CenterHeader = "" 'NI AU CENTRE
.RightHeader = "" 'NI A DROITE
.LeftMargin = Application.InchesToPoints(0.4) 'MARGE GAUCHE = 1 Cm
.RightMargin = Application.InchesToPoints(0.4) 'MARGE DROITE = 1 Cm
.TopMargin = Application.InchesToPoints(0.4) 'MARGE HAUT = 1 Cm
.BottomMargin = Application.InchesToPoints(0.4) 'MARGE BAS = 1 Cm
.HeaderMargin = Application.InchesToPoints(0.4) 'MARGE ENTETEPAGE = 1 Cm
.FooterMargin = Application.InchesToPoints(0.4) 'MARGE PIEDPAGE = 1 Cm
.PrintHeadings = False 'ENTETE FEUIL & COL NON IMPRIMES
.PrintGridlines = False 'QUADRILLAGE des CELS NON IMPRIMES
.PrintComments = xlPrintNoComments 'PAS IMP COMMENTAIRES
.CenterHorizontally = False 'PAS DE CENTRAGE DE LA PAGE H
.CenterVertically = False 'PAS DE CENTRAGE DE LA PAGE V
.Orientation = 1 '1=PORTRAIT,2=PAYSAGE
.Draft = False 'IMPRESSION = NORMAL
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Sheets("Menu").Range("A65536").End(xlUp).Offset(1, 0).Value = Reponse
Sheets("Menu").Activate
'
End Sub
 
Re : Nom de Feuilles

Bonjour le fil, bonjour le forum,

Pour l'ajout et le changement j'ai un peu modifié ton code :
Code:
Sub AjouterFeuille()
 
Dim Sh As Worksheet
Dim Reponse As String
Dim LeString As String
LeString = ":\/?*[]"
 
deb:
 
Reponse = InputBox("NOM de votre" _
    + vbCrLf + "NOUVELLE FEUILLE dans le CLASSEUR?", _
    "NOM FEUILLE ??? ", MonNom)
If Reponse = "" Then Exit Sub
'Vérifier que le nom n'existe pas déja
For Each Sh In Sheets
    If UCase(Reponse) = UCase(Sh.Name) Then
        If MsgBox( _
            "NOM de FEUILLE DEJA EXISTANT," _
            + vbCrLf + vbCrLf + _
            "LE REMPLACER ??.", vbYesNo + vbOKOnly, _
            "NOM DEJA EXISTANT") = vbYes Then
 
                Application.DisplayAlerts = False
                Worksheets(Reponse).Delete
                Application.DisplayAlerts = True
                Reponse = ""
                Sheets("Menu").Range("A65536").End(xlUp).Value = ""
                GoTo deb
 
        Else
            Exit Sub
        End If
 
    End If
Next Sh
 
'Vérifier que le nombre de caracteres du nom ne dépassent 31...
If Len(Reponse) > 31 Then
    MsgBox "LE NOM EST TROP LONG !!!! (" & _
        Len(Reponse) & ") IL DEPASSE" _
        + vbCrLf + " 31 CARACTERES"
    GoTo deb
End If
 
'Vérifier l'emploi de caracteres interdits...dans le nom
For a = 1 To 7
    If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0 Then
        MsgBox "CE (CES) CARACTERES " & _
            LeString & " NE SONT PAS AUTORISE(S)" _
            + vbCrLf + "DANS LE NOM D'UNE FEUILLE", _
            vbCritical + vbOKOnly, "CARACTERE INTERDITS !!!!!!!"
        GoTo deb
    End If
Next a
Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sh.Name = Reponse
 
'mise en page VBA avec l'objet PageSetup
ActiveSheet.DisplayPageBreaks = False
With ActiveSheet.PageSetup
.LeftHeader = "" 'AUCUN ENTETE DE PAGE A GAUCHE
.CenterHeader = "" 'NI AU CENTRE
.RightHeader = "" 'NI A DROITE
.LeftMargin = Application.InchesToPoints(0.4) 'MARGE GAUCHE = 1 Cm
.RightMargin = Application.InchesToPoints(0.4) 'MARGE DROITE = 1 Cm
.TopMargin = Application.InchesToPoints(0.4) 'MARGE HAUT = 1 Cm
.BottomMargin = Application.InchesToPoints(0.4) 'MARGE BAS = 1 Cm
.HeaderMargin = Application.InchesToPoints(0.4) 'MARGE ENTETEPAGE = 1 Cm
.FooterMargin = Application.InchesToPoints(0.4) 'MARGE PIEDPAGE = 1 Cm
.PrintHeadings = False 'ENTETE FEUIL & COL NON IMPRIMES
.PrintGridlines = False 'QUADRILLAGE des CELS NON IMPRIMES
.PrintComments = xlPrintNoComments 'PAS IMP COMMENTAIRES
.CenterHorizontally = False 'PAS DE CENTRAGE DE LA PAGE H
.CenterVertically = False 'PAS DE CENTRAGE DE LA PAGE V
.Orientation = 1 '1=PORTRAIT,2=PAYSAGE
.Draft = False 'IMPRESSION = NORMAL
.PaperSize = xlPaperA4 'chez moi j'ai un bug avec cette ligne ???
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
 
Sheets("Menu").Range("A65536").End(xlUp).Offset(1, 0).Value = Reponse
Sheets("Menu").Activate
 
End Sub

Pour supprimer un onglet je te propose ce bout de code :
Code:
Sub Supprime()
 
Dim r As Range 'déclare la variable r
 
'supprime le nom de la liste
With Sheets("Menu").Range("A250").CurrentRegion 'prend en compte la liste des onglets
    Set r = .Find(ActiveSheet.Name) 'définit la variable r
    r.Delete Shift:=xlUp 'suprime la cellule r en décalant les celluoes vers le haut
End With 'fin de la prise en compte de la liste des cellules
 
'supprime l'onglet
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
 
'reviens sur l'onglet menu
Sheets("Menu").Activate
 
End Sub
 
Re : Nom de Feuilles

Salut ROBERT Gdr Brava pour l'arrêt du Tabac moi ne peux seul dp 20 ans et marquer par une TS je submerge grace à mes Filles et mon p'tit Fils. Bref ....... Grd Merci pour tes codes je vais les Tester mais certain que si je respecte tes consignes ils vont faire mon Bonheur , Si autres PB puije te contacter ???? Mon Mail est : gds35@free.fr
Encore Merci et excellente soirée; GéGé
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
707
Retour