Fichier créé par macro - empêcher la modification des noms de fichier

sr94

XLDnaute Occasionnel
Bonjour

J'ai un classeur avec une macro qui me permet de créer plusieurs classeurs (un par collaborateur, avec la date de création dans le nom du fichier)

Voici cette macro :
Code:
Sub CreeClasseurs()

'Macro pour générer des prodution schedules par fournisseur

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error Resume Next
Kill "S:\Achats\COMMUN\Tableau de suivi\Production Status\*.*"
On Error GoTo 0

[A4:AF5000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[AI4], Unique:=True
For Each c In Range("AI5", Range("AI65000").End(xlUp))
Range("AI5") = c
Sheets.Add
Sheets("Feuil1").[A4:AF5000].AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Feuil1").[AI4:AI5], CopyToRange:=[A1], Unique:=False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$AF$2000"), , xlYes).Name = _
        "Tableau2"
        

ActiveSheet.Columns("A:AF").AutoFit
ActiveSheet.Range("A:A,B:B,C:C,F:F,G:G").EntireColumn.Hidden = True
ActiveSheet.Range("D1") = "Production Manager"
ActiveSheet.Range("H1") = "Supplier"
ActiveSheet.Range("E1") = "OA#"
ActiveSheet.Range("I1") = "Style"
ActiveSheet.Range("J1") = "Color"
ActiveSheet.Range("K1") = "Size"
ActiveSheet.Range("L1") = "Order Quantity"
ActiveSheet.Range("M1") = "Order ETD"
ActiveSheet.Range("N1") = "Order Warehouse Date"
ActiveSheet.Range("O1") = "Revised ETD"
ActiveSheet.Range("P1") = "Delay"
ActiveSheet.Range("Q1") = "Partial Qty"
ActiveSheet.Range("R1") = "Balance"
ActiveSheet.Range("Z1") = "FRI status"
ActiveSheet.Range("AE1") = "Warehouse Date"
ActiveSheet.Range("AF1") = "Comments"
ActiveSheet.Copy
nf = Replace(Replace(Replace(Replace(Replace(c, "/", "_"), "&", "_"), "...", "_"), ".", "_"), " ", "_")
Application.ScreenUpdating = False

'----------------------------------------------------
' Mise en forme conditionnelle

Range("A:AH").Select
Selection.FormatConditions.Delete

With Range("A2").Select
Set plage = Range("A2:AH" & Range("A65536").End(xlUp).Row)
plage.FormatConditions.Add Type:=xlExpression, Formula1:="=$AD2<>0"
plage.FormatConditions(1).Interior.ColorIndex = 35
plage.FormatConditions(1).Font.ColorIndex = 1

End With


With Range("Y2").Select
Set plage2 = Range("Y2:Y" & Range("Y65536").End(xlUp).Row)

plage2.FormatConditions.Add Type:=xlExpression, Formula1:="=SI($O2<>"""";$Y2>=$O2;et($E2<>"""";$Y2>=$M2) )"
plage2.FormatConditions(2).Interior.ColorIndex = 3
plage2.FormatConditions(2).Font.ColorIndex = 2
plage2.FormatConditions(2).Font.Bold = True

plage2.FormatConditions.Add Type:=xlExpression, Formula1:="=ET($E2<>"""";$AA2="""";$Y2<AUJOURDHUI())"
plage2.FormatConditions(3).Interior.ColorIndex = 6
plage2.FormatConditions(3).Font.ColorIndex = 1

End With

'------------------------------------------------------------


' Suite du code

ActiveSheet.Name = Left(nf, 31)
ActiveWorkbook.SaveAs Filename:="S:\Achats\COMMUN\Tableau de suivi\Production Status\" & "Production_status_" & nf & "_" & Format(Date, "d-mm-yy")
ActiveWorkbook.Close
ActiveSheet.Delete
Next c

' Ouverture de la boîte de dialogue

MsgBox "Les fichiers ont bien été créés dans S:\Achats\COMMUN\Tableau de suivi\Production Status\  !"
Shell "explorer.exe S:\Achats\COMMUN\Tableau de suivi\Production Status", 1

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Une fois les classeurs par collaborateur générés je souhaiterais que le nom du fichier ne puisse pas être modifié que ce soit par "enregistrer sous", ou par l'explorateur.

J'ai bien vu plusieurs piste dans le forum, mais vu que le nom de fichier est créé par la macro, je butte ...

Merci beaucoup !
 

DoubleZero

XLDnaute Barbatruc
Re : Fichier créé par macro - empêcher la modification des noms de fichier

Bonjour, sr94, le Forum,

Sur mon poste, le code mentionné infra s'avère opérationnel.

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Adaptation d'un code de lSteph (Merci !)
If SaveAsUI Then
MsgBox "Ce fichier ne peut être enregistré sous un autre nom... "
Cancel = True
End If
End Sub

Il peut, toutefois, être fastidieux :rolleyes: de le répéter x fois pour chaque fichier nouvellement créé.

A bientôt :)
 

sr94

XLDnaute Occasionnel
Re : Fichier créé par macro - empêcher la modification des noms de fichier

Bonjour

Merci pour ta proposition mais en effet 2 problèmes se posent :

- la macro doit pouvoir être placée dans chaque fichier de façon automatique, elle doit donc être intégrée à la macro de mon post
d'origine
- et le fichier ne doit pas pouvoir être renommé par l'explorateur

Merci beaucoup !
 

sr94

XLDnaute Occasionnel
Re : Fichier créé par macro - empêcher la modification des noms de fichier

si on ne peut pas faire ça, peut-on stocker le nom enregistré avec la macro dans une cellule masquée, et mettre une message box à l'ouverture et à la fermeture si le nom de fichier est différent ?