Enregistrer onglet avec un mot de passe et en supprimant les boutons

Salut les pros d'Excel

J'ai un code qui me permet d'enregistrer tous mes onglets séparéments, chacun dans un nouveau document. Je souhaiterais supprimer les boutons visibles sur l'onglet, définir un mot de passe et que l'enregistrement se fasse en format .xlsx

Voici mon code, comment puis-je insérer l'option mot de passe et l'option supprimer bouton? Et format .xlsx non xls comme c'est actuellement...

.Protect Password:="000000", AllowFiltering:=True 'protéger page par un mot de passe pour bloquer les modifications'

.Buttons.Delete 'supprime les boutons visibles de la page'

wbk.SaveAs dos & nom & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled

J'ai fait plusieurs tests mais ça ne fonctionne pas Voici mon code sans les 2 codes mentionnés ci-dessus

Option Explicit

Sub enregistrer()

Dim wbk As Workbook 'déclare la variable wbk (Fichier)

Dim wsh As Worksheet 'déclare la variable wsh (Onglet)

Dim nom As String 'déclare la variable nom (Nom de l'Onglet)

Dim dos As String 'déclare la variable dos (chemin d'accès)

dos = ThisWorkbook.Path & "\" 'définit la variable dos

For Each wsh In ThisWorkbook.Worksheets 'boucle sur tous les onglets du classeur

nom = wsh.Name

Select Case nom 'liste des onglets qu'on ne souhaite pas sauvegarder

Case "Médicaments", "Protocoles", "Stats", "Modèle", "Infos", "Mail"

Case Else

Set wbk = Workbooks.Add(xlWorksheet)

wbk.Worksheets(1).Name = nom & "0" 'pour éviter les doublons

wsh.Copy after:=wbk.Worksheets(1)

Application.DisplayAlerts = False

wbk.Worksheets(1).Delete

wbk.SaveAs dos & nom & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled

Application.DisplayAlerts = True

wbk.Close

Set wbk = Nothing

End Select

Next wsh

End Sub

Au plaisir de vous lire et encore merci à tous ceux qui m'ont déjà aidée jusqu'à présent

Bonjour Sophie ,

une solution possible:

Sub test()

    Dim wks    As Worksheet
    Dim newWks As Worksheet
    Dim dos    As String  'déclare la variable dos (chemin d'accès)
    Dim i      As Integer

    dos = ThisWorkbook.Path & "\"  'définit la variable dos

    Application.ScreenUpdating = False

    For i = 7 To ThisWorkbook.Worksheets.Count
        Sheets(i).Copy
        Set newWks = ActiveSheet
        With newWks
            .Buttons.Delete
            .Protect Password:="000000"
            Application.DisplayAlerts = False
            .Parent.SaveAs FileName:=dos & .Name, _
                           FileFormat:=xlOpenXMLWorkbook
            Application.DisplayAlerts = True
            .Parent.Close savechanges:=False
        End With
    Next

    Application.ScreenUpdating = True

End Sub

Salut mon sauveur!!!

Excuse le retard de ma réponse mais j'étais en vacances

Génial ton code, il fonctionne parfaitement!!!!

Encore un énorme merci pour toute l'aide que tu m'as apportée, tu es vraiment un as!!!

Merciiiiiiiiiiiii mille fois et peut-être à bientôt sur le forum

Sophie

Oh Sequoyah, j'ai encore un petit service à te demander....

Dans ton code, tu arrives à me mettre l'option que sur chacun des onglets à sauvegarder, s'il n'y a rien dans la case A12 alors il ne faut pas le sauvegarder, sinon faut faire la sauvegarde avec le superbe code que tu m'as fourni

Merci à toi pour la suite de cette demande

Bonjour Sophie ,

merci pour ton retour, ajoute après la ligne:

For i = 7 To ThisWorkbook.Worksheets.Count

cette ligne:

If Not IsEmpty(Sheets(i).Range("A12")) Then

et après la ligne

End With

les mots

End If

Ça paraît tellement simple lorsque je te lis.... Je pense que tu as dû tomber dedans comme Obélix

Bravo, ça fonctionne du tonnerre!!! Sans toi, je pense que mon ordinateur aurait volé à travers la vitre

Encore une fois, merciiiiiiiiiiiiiiiiiiiiiiiii infiniment pour ton aide, ta patience et ta rapidité, la grande classe!!!!!

Excellente soirée à toi et à tout bientôt