Enregistrement d'un nouveau document Excel en tant que classeur sans macro sans invite

Question

J'utilise Excel 2010. Un modèle prenant en charge les macros Excel possède une connexion de données à un fichier texte configuré pour s'actualiser automatiquement lorsqu'un nouveau document est créé à l'aide de ce modèle.

La macro suivante se trouve dans l'objet "ThisWorkbook" pour supprimer la connexion de données avant d'enregistrer le nouveau document:

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

    Do While ActiveWorkbook.Connections.Count > 0
        ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
    Loop

End Sub

Lorsqu'un utilisateur clique sur l'icône de sauvegarde/appuie sur les touches ctrl + S, saisit un nom de fichier, puis clique sur enregistrer pour l'enregistrer en tant que classeur Excel sans macro (comme c'est le type de fichier par défaut et requis), un message indiquant:

Les fonctionnalités suivantes ne peuvent pas être enregistrées dans des classeurs sans macro:

• projet VB

Pour enregistrer un fichier avec ces fonctionnalités, cliquez sur Non, puis choisissez un fichier type de fichier activé par macro dans la liste Type de fichier.

Pour continuer à enregistrer en tant que classeur sans macro, cliquez sur Oui.

Est-il possible d'empêcher l'affichage de ce message et de laisser Excel supposer que l'utilisateur souhaite continuer avec un classeur sans macro?

J'ai cherché partout et je comprends que je pourrai peut-être ajouter du code à l'objet de classeur qui se supprime lui-même, de sorte que Excel n'a pas de projet VB pouvant générer ce message, mais que chaque utilisateur devra modifier les paramètres du Centre de gestion de la confidentialité ( Faites confiance à l'accès au modèle d'objet de projet VBA), ce que je veux éviter.

J'ai aussi vu des suggestions d'utilisation:

Application.DisplayAlerts = False

mais ne peut pas obtenir que cela fonctionne. Chaque exemple d'utilisation semble se trouver dans un sous-traitant qui gère également l'enregistrement du document, alors que dans mon cas, le sous BeforeSave se termine avant que le document ne soit enregistré de manière non vba par défaut, ce qui explique peut-être pourquoi il ne fonctionne pas?

Cette propriété est-elle réinitialisée sur une valeur par défaut True après la fin du sous-programme/avant la sauvegarde?

Toutes mes excuses pour les absurdités que j'ai pu avoir, mon expérience avec VBA est très limitée.

Answer 1

Une approche différente ... lorsque le modèle est chargé, oblige l'utilisateur à enregistrer en tant que (j'ai un classeur/modèle avec une situation similaire ...). Cela devrait les ouvrir dans le dossier Documents de l'utilisateur, bien que vous puissiez ajuster l'enregistrement dans n'importe quel emplacement.

Dans le module ThisWorkbook, mettez:

Option Explicit

Private Sub Workbook_Open()
    Dim loc As Variant
    Application.DisplayAlerts = False
    loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\NAME_OF_FILE")
    If loc <> False Then
        ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
        Exit Sub
    End If
    Application.DisplayAlerts = True
End Sub

---

Edit1: Ajout de l'instruction if en utilisant un nom de modèle de base, afin que les sauvegardes suivantes n'invitent pas à enregistrer en tant que:

Option Explicit

Private Sub Workbook_Open()
    If ActiveWorkbook.Name = "_NAME_OF_FILE.xlsb" Then
        Dim loc As Variant
        Application.DisplayAlerts = False 
        loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\_NAME_OF_FILE")
        If loc <> False Then
            ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
            Exit Sub
        End If
        Application.DisplayAlerts = True
    End If
End Sub

Answer 2

Je ne peux pas tester sur Excel 2010, mais au moins pour 2016, ça fonctionne très bien:

Sub SaveAsRegularWorkbook()

    Dim wb As Workbook
    Dim Path As String

    Set wb = ThisWorkbook
    Path = "T:\he\Path\you\prefer\"
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    wb.SaveAs Filename:=Path & "Test.xlsx", FileFormat:=51
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub

Essaie.

Answer 3

Pour cette réponse, je suppose que par modèle basé sur une macro Excel, vous voulez dire un fichier xltm. Je suppose également que ce que vous entendez par "nouveau document" est le document généré lorsqu'un utilisateur double-clique sur le fichier xtlm (par conséquent, ce nouveau fichier n'a pas d'emplacement car il n'a pas encore été enregistré). 

Pour résoudre votre problème, vous pouvez utiliser une fenêtre personnalisée SaveAs (Application.GetSaveAsFilename) pour mieux contrôler la façon dont l'utilisateur enregistre le fichier lorsque la macro d'événement Workbook_BeforeSave est appelée.

Voici comment l'implémenter:

1 - Copiez ce code dans un nouveau module. 

Option Explicit  

Sub SaveAsCustomWindow()  

    Const C_PROC_NAME As String = "SaveAsCustomWindow"
    Dim strFullFileName As String, strPreferedFolder As String, strDefaultName As String
    Dim UserInput1 As Variant, UserInput2 As Variant
    Dim isValidName As Boolean, isFileClosed As Boolean, isWorkbookClosed As Boolean
    Dim strFilename As String, strFilePath As String


    'To avoid Warning when overwriting
    Application.DisplayAlerts = False
    'Disable events (mostly for the BeforeSave event) to avoid creating infinite loop
    Application.EnableEvents = False
    On Error GoTo ErrHandler

    'Customizable section
    strDefaultName = ThisWorkbook.Name
    strPreferedFolder = Environ("USERPROFILE")

    Do While isWorkbookClosed = False
        Do While isFileClosed = False
            Do While isValidName = False
                UserInput1 = Application.GetSaveAsFilename(InitialFileName:=strPreferedFolder & "\" & strDefaultName, FileFilter:="Excel Workbook (*.xlsx),*.xlsx")

                If UserInput1 = False Then
                    GoTo ClosingStatements 'This is important to take care of the case when the user presses cancel
                Else
                    strFullFileName = UserInput1
                End If

                strFilename = Right(strFullFileName, Len(strFullFileName) - InStrRev(strFullFileName, "\"))
                strDefaultName = strFilename

                strFilePath = Left(strFullFileName, InStrRev(strFullFileName, "\") - 1)
                strPreferedFolder = strFilePath

                'If the file exist, ask for overwrite permission
                If Dir(strFullFileName) <> "" Then
                    UserInput2 = MsgBox(strFilename & " already exists." & vbNewLine & "Do you want to overwrite?", vbYesNoCancel Or vbExclamation)
                    If UserInput2 = vbNo Then
                        isValidName = False
                    ElseIf UserInput2 = vbYes Then
                        isValidName = True
                    ElseIf UserInput2 = vbCancel Then
                        GoTo ClosingStatements
                    Else
                        GoTo ClosingStatements
                    End If
                Else
                    isValidName = True
                End If
            Loop

            'Check if file is actually open
            If isFileOpen(strFullFileName) Then
                MsgBox "The workbook you want to overwrite is currently open. Choose a different name, or close the  workbook before saving.", vbExclamation
                isValidName = False
                isFileClosed = False
            Else
                isFileClosed = True
            End If
        Loop

        'Check if an opened workbook has the same name
        If isWorkbookOpen(strFilename) Then
            MsgBox "You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.", vbExclamation
            isValidName = False
            isFileClosed = False
            isWorkbookClosed = False
        Else
            isWorkbookClosed = True
        End If
    Loop

    ThisWorkbook.SaveAs Filename:=strFullFileName, FileFormat:=xlOpenXMLWorkbook

ClosingStatements:
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Exit Sub
ErrHandler:
    Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
         "While running: " & C_PROC_NAME & IIf(Erl <> 0, vbNewLine & "Error Line: " & Erl, "")
    GoTo ClosingStatements

End Sub

Function isFileOpen(ByVal Filename As String) As Boolean

    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open Filename For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
        Case 0:    isFileOpen = False
        Case 70:   isFileOpen = True
    End Select

End Function

Function isWorkbookOpen(ByVal Filename As String) As Boolean

    Dim wb As Workbook, ErrNo As Long

    On Error Resume Next
    Set wb = Workbooks(Filename)
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
        Case 0:         isWorkbookOpen = True
        Case Else:      isWorkbookOpen = False
    End Select

End Function

Explication de la partie 1 : Tout cela peut sembler un peu exagéré, mais toute la gestion des erreurs est importante ici pour prendre en compte les erreurs potentielles et vous assurer que le paramètre pour Application.EnableEvents est redéfini sur TRUE même si une erreur se produit . Sinon, toutes les macros d'événement seront désactivées dans votre application Excel.

2 - Appelez la procédure SaveAsCustomWindow dans la procédure d'événement Workbook_BeforeSave comme suit: 

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

    'Your code

    If ThisWorkbook.Path = "" Then
        SaveAsCustomWindow
        Cancel = True
    End If

End Sub

Notez que nous devons définir la variable Cancel = True afin d'empêcher l'affichage de la fenêtre SaveAs par défaut. De plus, l'instruction if est là pour vous assurer que la fenêtre SaveAs personnalisée ne sera utilisée que si le fichier a été enregistré jamais.

Answer 4

Pour répondre à vos questions:

Est-il possible d'empêcher ce message d'apparaître?

Oui, en utilisant la propriété Application.DisplayAlerts

Est-il possible de laisser Excel supposer que l'utilisateur souhaite continuer avec un classeur sans macro?  

Non, vous devez écrire la procédure pour enregistrer le classeur, ignorer l'événement SaveAs Excel et enregistrer le classeur à l'aide de l'entrée utilisateur (Path & Filename) avec le format requis.

La procédure suivante utilise un FileDialog pour capturer le chemin d'accès et le nom du fichier de l'utilisateur, puis enregistre le fichier sans afficher le message d'avertissement .. J'ai ajouté quelques commentaires explicatifs, mais laissez-moi savoir de vos questions.

Copiez ces procédures dans le module ThisWorkbook:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True       'Prevents repetitive Save
    Call Workbook_BeforeSave_ApplySettings_And_Save
    End Sub


Private Sub Workbook_BeforeSave_ApplySettings_And_Save()
Dim fd As FileDialog, sFilename As String

    Rem Sets FileDialog to capture user input
    Set fd = Application.FileDialog(msoFileDialogSaveAs)
    With fd
        .InitialView = msoFileDialogViewDetails
        .Title = vbNullString               'Resets default value in case it was changed
        .ButtonName = vbNullString          'Resets default value in case it was changed
        .AllowMultiSelect = False
        If .Show = 0 Then Exit Sub          'User pressed the Cancel Button
        sFilename = .SelectedItems(1)
    End With

    With ThisWorkbook

        Do While .Connections.Count > 0
            .Connections.Item(.Connections.Count).Delete
        Loop

        Application.EnableEvents = False                                'Prevents repetition of the Workbook_BeforeSave event
        Application.DisplayAlerts = False                               'Prevents Display of the warning message
        On Error Resume Next                                            'Prevents Events and Display staying disable in case of error
        .SaveAs Filename:=sFilename, FileFormat:=xlOpenXMLWorkbook      'Saves Template as standard Excel using user input
        If Err.Number <> 0 Then
            MsgBox "Run-time error " & Err.Number & String(2, vbLf) _
                & Err.Description & String(2, vbLf) _
                & vbTab & "Process will be cancelled.", _
                vbOKOnly, "Microsoft Visual Basic"
        End If
        On Error GoTo 0
        Application.DisplayAlerts = True
        Application.EnableEvents = True

    End With

    End Sub