Nom du fichier automatique

Le 30/10/2019 à 08:51

Amnezia a écrit :
Pedro22 a écrit :
Je viens aussi d'avoir un crash d'Excel, je ne saurais l'expliquer.
Si d'autres ont une idée...
J'ai l'impression que comme on modifie la variable qu'il utilise pour sauvegarder il n'arrive pas à faire la part des choses, vue qu'il renomme le document sur lequel il travail...
Merci pour tout Pedro !! tu m'a énormément aidé !!

Un essai supplémentaire (la modification est applicable aussi sur l'autre macro) :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    VersionDoc = Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Dernière cellule non vide en colonne B de l'onglet "Changelog"
    SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm"
    Application.DisplayAlerts = False 
    If SaveFileName = ThisWorkbook.Name Then 
        ActiveWorkbook.Save 'Enregistre le document actuel
    Else 
        ActiveWorkbook.SaveAs Filename:=SaveFileName, FileFormat:=52 'Enregistrement sous le nouveau nom
    End If
    Application.DisplayAlerts = True

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " a échoué !"
    Cancel = True 'Annule l'enregistrement du classeur
    Application.DisplayAlerts = True

End Sub

Le 30/10/2019 à 10:27

Pedro22 a écrit :

Un essai supplémentaire (la modification est applicable aussi sur l'autre macro) :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    VersionDoc = Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Dernière cellule non vide en colonne B de l'onglet "Changelog"
    SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm"
    Application.DisplayAlerts = False 
    If SaveFileName = ThisWorkbook.Name Then 
        ActiveWorkbook.Save 'Enregistre le document actuel
    Else 
        ActiveWorkbook.SaveAs Filename:=SaveFileName, FileFormat:=52 'Enregistrement sous le nouveau nom
    End If
    Application.DisplayAlerts = True

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " a échoué !"
    Cancel = True 'Annule l'enregistrement du classeur
    Application.DisplayAlerts = True

End Sub

Merci mais cela plante encore, il me crée bien le nouveau fichier mais le fichier en cours plante...

Le 30/10/2019 à 10:31

Amnezia a écrit :
Merci mais cela plante encore, il me crée bien le nouveau fichier mais le fichier en cours plante...

Alors là je sèche !

Le 30/10/2019 à 10:40

Pedro22 a écrit :
Amnezia a écrit :
Merci mais cela plante encore, il me crée bien le nouveau fichier mais le fichier en cours plante...
Alors là je sèche !

Et autre solution, peut on désactiver cette fonction ?

Cela résous le soucis xD

Le 30/10/2019 à 11:59

Amnezia a écrit :
Et autre solution, peut on désactiver cette fonction ?
Cela résous le soucis xD

Quelle fonction ?

Le 30/10/2019 à 12:02

Pedro22 a écrit :
Amnezia a écrit :
Et autre solution, peut on désactiver cette fonction ?
Cela résous le soucis xD
Quelle fonction ?

Bah la disquette qui permet l'enregistrement rapide, mais juste sur ce doc.

Le 30/10/2019 à 12:32

Autre essai :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    Cancel = True 'Annule l'enregistrement "classique" du classeur
    With ThisWorkbook
        VersionDoc = .Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Dernière cellule non vide en colonne B de l'onglet "Changelog"
        SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm"
        Application.DisplayAlerts = False 
        If SaveFileName = .Name Then .Save Else .SaveAs Filename:=SaveFileName, FileFormat:=52
        Application.DisplayAlerts = True
    End With

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " a échoué !"
    Application.DisplayAlerts = True

End Sub

Le 30/10/2019 à 12:45

Pedro22 a écrit :

Autre essai :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    Cancel = True 'Annule l'enregistrement "classique" du classeur
    With ThisWorkbook
        VersionDoc = .Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Dernière cellule non vide en colonne B de l'onglet "Changelog"
        SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm"
        Application.DisplayAlerts = False 
        If SaveFileName = .Name Then .Save Else .SaveAs Filename:=SaveFileName, FileFormat:=52
        Application.DisplayAlerts = True
    End With

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " a échoué !"
    Application.DisplayAlerts = True

End Sub

Cela m'empêche totalement d'enregistrer...

Je n'arrive pas à comprendre ce que tu as ajouté en plus xD

Le 30/10/2019 à 13:36

Je pense avoir trouvé, chaque fois que l'on demande à VBA d'enregistrer le classeur, l'évenement BeforeSave s'exécute à nouveau, ce qui créé une boucle infinie et fait planter Excel.

Un autre essai :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    With ThisWorkbook
        VersionDoc = .Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Dernière cellule non vide en colonne B de l'onglet "Changelog"
        SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm"
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        If SaveFileName = .Name Then .Save Else .SaveAs Filename:=.Path & "\" & SaveFileName, FileFormat:=52
        Application.EnableEvents = True
        Application.DisplayAlerts = True
    End With

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " dans le répertoire : " & ThisWorkbook.Path & "\ a échoué !"
    Cancel = True 'Annule l'enregistrement "classique" du classeur
    Application.DisplayAlerts = True

End Sub

Le 30/10/2019 à 14:22

Pedro22 a écrit :

Je pense avoir trouvé, chaque fois que l'on demande à VBA d'enregistrer le classeur, l'évenement BeforeSave s'exécute à nouveau, ce qui créé une boucle infinie et fait planter Excel.

Un autre essai :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    With ThisWorkbook
        VersionDoc = .Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Dernière cellule non vide en colonne B de l'onglet "Changelog"
        SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm"
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        If SaveFileName = .Name Then .Save Else .SaveAs Filename:=.Path & "\" & SaveFileName, FileFormat:=52
        Application.EnableEvents = True
        Application.DisplayAlerts = True
    End With

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " dans le répertoire : " & ThisWorkbook.Path & "\ a échoué !"
    Cancel = True 'Annule l'enregistrement "classique" du classeur
    Application.DisplayAlerts = True

End Sub

Yeah !! Trop bon !!

Tu es au TOP Pedro !!

On est d'accord j'ai mis le même code dans "BeforeSave" & "BeforeClose".

En tout cas tout à l'air de fonctionner correctement.

Un grand merci à toi !!

Le 30/10/2019 à 14:31

Dans BeforeClose il faut juste supprimer l'instruction :

SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"

PS :

Le 30/10/2019 à 14:38

Pedro22 a écrit :
Dans BeforeClose il faut juste supprimer l'instruction :
SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
PS :

Merci pour tout

Le 30/10/2019 à 14:42

Pedro22 a écrit :

Je pense avoir trouvé, chaque fois que l'on demande à VBA d'enregistrer le classeur, l'évenement BeforeSave s'exécute à nouveau, ce qui créé une boucle infinie et fait planter Excel.

Un autre essai :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    With ThisWorkbook
        VersionDoc = .Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Dernière cellule non vide en colonne B de l'onglet "Changelog"
        SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm"
        Application.DisplayAlerts = False
        Application.EnableEvents = False
        If SaveFileName = .Name Then .Save Else .SaveAs Filename:=.Path & "\" & SaveFileName, FileFormat:=52
        Application.EnableEvents = True
        Application.DisplayAlerts = True
    End With

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " dans le répertoire : " & ThisWorkbook.Path & "\ a échoué !"
    Cancel = True 'Annule l'enregistrement "classique" du classeur
    Application.DisplayAlerts = True

End Sub

Je veux pas être trop chiant, mais tu saurais me commenter un peut le code que j'y vois plus claire ?

merci d'avance Pedro

Le 30/10/2019 à 17:09

Oui j'ajoute des commentaires.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr 'En cas d'erreur, VBA exécute une section spécifique de code (voir fin de macro)
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    With ThisWorkbook 'Tout élément commençant par "." se rapporte à ce classeur
        VersionDoc = .Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Contenu de la dernière cellule non vide en colonne B de l'onglet "Changelog"
        SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm" 'Nom reconstitué en ajoutant la date, la version du document et l'extension du fichier
        Application.DisplayAlerts = False 'Désactive l'affichage de boites de dialogues du type "voulez vous écraser le fichier existant ?"
        Application.EnableEvents = False 'Désactive l’exécution des procédures événementielles (telle que celle-ci, pour éviter qu'elle ne s’exécute en boucle)
        'Si le nom créé est le même que celui de ce document, on enregistre simplement, sinon on enregistre sous le nouveau nom au format "xlsm" dans le même répertoire que ce classeur
        If SaveFileName = .Name Then .Save Else .SaveAs Filename:=.Path & "\" & SaveFileName, FileFormat:=52
        Application.EnableEvents = True 'Réactive les procédures événementielles
        Application.DisplayAlerts = True 'Réactive les boîtes de dialogue
    End With

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " dans le répertoire : " & ThisWorkbook.Path & "\ a échoué !"
    Cancel = True 'Annule l'enregistrement du classeur
    Application.DisplayAlerts = True

End Sub

Le 30/10/2019 à 17:24

Pedro22 a écrit :

Oui j'ajoute des commentaires.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Déclaration des variables
    Dim VersionDoc As String, SaveFilName As String

    On Error GoTo GestionErr 'En cas d'erreur, VBA exécute une section spécifique de code (voir fin de macro)
    SaveAsUI = False 'N'affiche pas la boite de dialogue "enregistrer sous"
    With ThisWorkbook 'Tout élément commençant par "." se rapporte à ce classeur
        VersionDoc = .Sheets("Changlog").Range("B" & Rows.Count).End(xlUp) 'Contenu de la dernière cellule non vide en colonne B de l'onglet "Changelog"
        SaveFileName = "S2-PDGS-TAS-DI-NDD-V11.Annex_C.SAB1_OBS Cloud_Connectivity_Matrix_" & Format(Date, "dd-mm-yyyy") & "_" & VersionDoc & ".xlsm" 'Nom reconstitué en ajoutant la date, la version du document et l'extension du fichier
        Application.DisplayAlerts = False 'Désactive l'affichage de boites de dialogues du type "voulez vous écraser le fichier existant ?"
        Application.EnableEvents = False 'Désactive l’exécution des procédures événementielles (telle que celle-ci, pour éviter qu'elle ne s’exécute en boucle)
        'Si le nom créé est le même que celui de ce document, on enregistre simplement, sinon on enregistre sous le nouveau nom au format "xlsm" dans le même répertoire que ce classeur
        If SaveFileName = .Name Then .Save Else .SaveAs Filename:=.Path & "\" & SaveFileName, FileFormat:=52
        Application.EnableEvents = True 'Réactive les procédures événementielles
        Application.DisplayAlerts = True 'Réactive les boîtes de dialogue
    End With

Exit Sub
GestionErr:
    MsgBox "L'enregistrement sous le nom : " & SaveFileName & " dans le répertoire : " & ThisWorkbook.Path & "\ a échoué !"
    Cancel = True 'Annule l'enregistrement du classeur
    Application.DisplayAlerts = True

End Sub

Tu es génial !! Merci infiniment Pedro !

Au plaisir de communiquer à nouveau avec toi !

Le 30/10/2019 à 17:48

Amnezia a écrit :
Tu es génial !! Merci infiniment Pedro !
Au plaisir de communiquer à nouveau avec toi !

Au plaisir ! J'ai encore pu progresser grâce à ta problématique, je suis chaque jour un peu moins con !

Rechercher des sujets similaires à "nom fichier automatique"