Enregistrement d'une seule feuille

[Tonyde54]

Bonjour a tous

Exceliennes et Exceliens

mon probleme et que
je voudrai un bouton qui m'enregistre la feuille sous un nom donner dans une cellule et qui fermera le classeur automatiquement apres l'enregistrement

et je voudrai que sur la feuille enregistré ne plus voir les objets placer dans le classeur modele ainsi que les commentaires dans des cellules.
exemple: (dans les cellules P16 et P19 )

et ensuite que la feuille enregistré ne soit plus modifiable

ça fait beaucoup de chose en meme temps
mais si vous pouvez m'aider pour une ou plusieur de mes demandes
ça serai supert


je tous remercie d'avance


bien amicalement

 

[Zon]

Salut,

Colles ceci dans un module standard, peut âtre qu'il va te manquer des objets à supprimer, dire lesquels le cas échéant, le nom de la feuille est définie par la constante NomF. Pour protéger la feuille j'utilise un scrollarea (c'est pour cela que je crée unez évènementielle workbook_open.

Le nom de fichier est saisi dans la cellule A1, si il n'est pas valide on propose de l'enregistrer.


Option Explicit
Const NomF$ = "Feuil1"

Sub Princ()
SupprComment Sheets(NomF)
SupprObjet Sheets(NomF)
SupprF NomF
On Error Resume Next
SupprUneProc ThisWorkbook, "ThisWorkbook", "Workbook_Open"
AjouterProcEven ThisWorkbook, "ThisWorkbook", "Open", "Workbook", Sheets(NomF).CodeName & ".scrollarea=""A1"""
ThisWorkbook.SaveAs Sheets(NomF).[A1].Text
If Err = 1004 Then Application.Dialogs(xlDialogSaveWorkbook).Show
End Sub

Sub SupprObjet(F As Worksheet)
Dim Obj As Shape
For Each Obj In F.Shapes
Obj.Delete
Next Obj
End Sub

Sub SupprComment(F As Worksheet)
Dim C As Comment
For Each C In F.Comments
C.Delete
Next C
End Sub
Sub SupprF(NomF$)
Dim F As Worksheet
Application.DisplayAlerts = False
For Each F In ThisWorkbook.Sheets
If F.Name <> NomF Then F.Delete
Next F
End Sub

Sub SupprUneProc(C As Workbook, NomModule$, Nomproc$)
With C.VBProject.VBComponents(NomModule).CodeModule
.DeleteLines .ProcStartLine(Nomproc, 0), .ProcCountLines(Nomproc, 0)
End With
End Sub

Sub AjouterProcEven(C As Workbook, NomModule$, Evenement$, Objet$, Code$)
With C.VBProject.VBComponents(NomModule).CodeModule
.InsertLines .CreateEventProc(Evenement, Objet) + 1, Code
End With
End Sub


A+++

 

[Tof]

Zon,

Ca marche pas mal, mais quand des cellules de la page sauvegardées font référence à d'autres feuilles, alors il y a problème.
Comment résoudre cela ?

 

[Zon]

Salut,

Tof testes en passant par un tableau intermédiaire,

Sub Princ()
dim T
with sheets(nomf)
T=.usedrange.value
.[A1].resize(ubound(t),ubound(t,2))=t
end with
SupprComment Sheets(NomF)
SupprObjet Sheets(NomF)
SupprF NomF
On Error Resume Next
SupprUneProc ThisWorkbook, "ThisWorkbook", "Workbook_Open"
AjouterProcEven ThisWorkbook, "ThisWorkbook", "Open", "Workbook", Sheets(NomF).CodeName & ".scrollarea=""A1"""
ThisWorkbook.SaveAs Sheets(NomF).[A1].Text
If Err = 1004 Then Application.Dialogs(xlDialogSaveWorkbook).Show
End Sub

A+++