Detection Fermeture Excel VBA

Bonjour à tous et à toutes

J'ai créer un programme VBA qui stocke des données dans un fichier Excel créer spécialement pour. J'aimerais que suite à la fermeture de ce fichier temporaire, celui ci soit supprimer du dossier Temp qu'il soit enregistrer ou non. J'ai vu qu'il existait la procédure Before_Close, mais en essayant de le mettre en place, il s’applique juste sur le fichier Excel de base. Comment faire s'il vous pait ?

Merci d'avance pour votre aide et votre temps.

CDT

SaintYor

Bonjour et bienvenue,

Je ne sais pas ce que tu as mis dans ton Before_Close mais avec ça,

Kill "C:\TEMP\mon_fichier.xlsx"

Le fichier temporaire va se supprimer.

A+

Bonjour et merci

Est ce que cette action va s'effectuer quand je vais fermer mon fichier temporaire ? parce que le code Before_Close est dans le fichier source.

Merci d'avance

SaintYor

Je n'ai peut-être pas bien saisi l'utilisation.

Ce que j'ai compris :
Quand tu ferme le dossier source, le fichier temporaire doit etre supprimé.
Si c'est le cas, dans la précédure before_close de ton fichier source tu mets le code

Kill "C:\TEMP\mon_fichier.xlsx"

où "mon_fichier" correspond a ton fichier temporaire.

Si tu souhaite que l'action se fasse quand le fichier temporaire se ferme, c'est plus compliqué a moin que tu puisse ne pas autoriser la sauvegarde du fichier temporaire.

En effet, c'est quand je ferme mon fichier temporaire qu'il est effacé . Donc c'est plus le second cas que tu décris.

Je ne sais même pas si c'est possible, tu peux donner plus d'info pour savoir comment ce fichier temporaire est créé ?

Imaginons que c'est possible :
Je te fais un fichier et je te l'envoi pour que tu le test, mais pour l'envoyer je dois l'enregistrer et le fermer et du coup, ??? si je le ferme il se supprime.

Je créer un fichier avec ceci :

tempFile = Environ("temp") & "\TempFile.xlsx"

Dim xlApp As Object
Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.Workbooks(1).SaveAs tempFile
xlApp.ActiveSheet.Cells(1, 1).Value = "Référence"
xlApp.ActiveSheet.Cells(1, 2).Value = "Observations"
xlApp.ActiveSheet.Cells(1, 3).Value = "Items"

et avec des boucles je remplie le fichier tempfile qui est un excel application

Voici tout le code :

Public tempFile As String
Sub Verification_Carnet_Ferrure()

    Dim DossierPlans As String

    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    DossierPlans = "Nom dossier des plans"

    'Appelle la procédure de recherche des fichiers
    Verification_Finale DossierPlans

    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.

End Sub
Sub Verification_Finale(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.

    Dim Fso                             As Scripting.FileSystemObject
    Dim SourceFolder                    As Scripting.Folder
    Dim SubFolder                       As Scripting.Folder
    Dim FileItem                        As Scripting.File
    Dim monfichier                      As String
    Dim PrecedentFileType               As String
    Dim i                               As Long
    Dim ListePlanFerrures()             As String
    Dim ListeIndice()                   As String
    Dim indiceFichier                   As String
    Dim ListeIndiceFichier()            As String
    Dim Nom_Fichier_Base                As String

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)

    tempFile = Environ("temp") & "\TempFile.xlsx"
    Nom_Fichier_Base = ThisWorkbook.Name
    i = 0
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'pas eu le choix de mettre Microsoft Edge PDF Document pour pouvoir intégrer les PDF, a voir si cela fonctionne avec tout les postes
        If FileItem.Type = "Fichier dwg" Or FileItem.Type = "Fichier DWG" Or FileItem.Type = "Microsoft Edge PDF Document" Or FileItem.Type = "*pdf*" Then
            monfichier = Split(FileItem.Name, ".")(0)
            If InStr(monfichier, "-") > 0 Then
                indiceFichier = Split(monfichier, "-")(1)
                monfichier = Split(monfichier, "-")(0)
                If i < 1 Then
                    ReDim Preserve ListePlanFerrures(i)
                    ReDim Preserve ListeIndiceFichier(i)
                    ListePlanFerrures(i) = monfichier
                    ListeIndiceFichier(i) = indiceFichier
                    i = i + 1
                End If
            End If
            If monfichier <> ListePlanFerrures(i - 1) Then
                'Inscrit le nom du fichier dans la Variable
                ReDim Preserve ListePlanFerrures(i)
                ReDim Preserve ListeIndiceFichier(i)
                ListePlanFerrures(i) = monfichier
                ListeIndiceFichier(i) = indiceFichier
                i = i + 1
            End If
        End If

    Next FileItem
'toute la partie précédente recense les plans DWG d'un fichier et récolte les indices de révisions
'------------------------------------------- Fin partie 1 -----------------------------
' Cette partie suivante récupère la liste précédente de plans et la compare a une nomenclature et s'il y a des différence, les stocks dans le fichier temporaire
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim p As Integer
Dim q As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer
Dim Colonne_Item() As Variant
Dim DebutFerrures As Integer
Dim Finferrures  As Integer
Dim FinPlans As Integer
Dim ListeFerrures() As String
Dim ListeIndiceFerrures() As String
Dim Liste_Item() As String
Dim LongListePlanFerrures As Integer
Dim LongListeFerrures As Integer
Dim Numero_Ligne_Piece() As Integer
Dim QuantitesFerrures() As Variant

Dim xlApp As Object
Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.Workbooks(1).SaveAs tempFile
xlApp.ActiveSheet.Cells(1, 1).Value = "Référence"
xlApp.ActiveSheet.Cells(1, 2).Value = "Observations"
xlApp.ActiveSheet.Cells(1, 3).Value = "Items"

'Pour adaptation dans futur carnet de ferrure Nommer case et la selectionner
Workbooks(Nom_Fichier_Base).Sheets("Nomenclature").Range("Deb_colonne_ref").Activate
DebutFerrures = ActiveCell.Row
Finferrures = ActiveWorkbook.Sheets("Nomenclature").Range("Der_ligne_Ferr").Row

'Création d'un nouveau fichier avec les colonnes qui vont bien et possibilité de l'enregistrer.

n = 0
For k = 0 To Finferrures - DebutFerrures
    If ActiveCell.Value = 0 Then
        ActiveCell.Offset(1, 0).Activate
    ElseIf ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
        ActiveCell.Offset(1, 0).Activate
    ElseIf InStr(1, ActiveCell.Value, "#") > 0 Or InStr(1, ActiveCell.Value, "Coefficient") > 0 Then
        ActiveCell.Offset(1, 0).Activate
    ElseIf ActiveCell.Offset(0, 6).Value = "" Then
        ActiveCell.Offset(1, 0).Activate
    Else
        ReDim Preserve ListeFerrures(n)
        ReDim Preserve QuantitesFerrures(n)
        ReDim Preserve ListeIndiceFerrures(n)
        ReDim Preserve Numero_Ligne_Piece(n)
        ListeFerrures(n) = ActiveCell.Value
        QuantitesFerrures(n) = ActiveCell.Offset(0, 8).Value
        ListeIndiceFerrures(n) = ActiveCell.Offset(0, 7).Value
        Numero_Ligne_Piece(n) = ActiveCell.Row
        n = n + 1
        ActiveCell.Offset(1, 0).Activate
    End If
Next

xlApp.Cells(1, 1).Activate
LongListePlanFerrures = UBound(ListePlanFerrures)
LongListeFerrures = UBound(ListeFerrures)
i = 2
For m = 0 To LongListePlanFerrures
    For n = 0 To LongListeFerrures
        If ListePlanFerrures(m) = ListeFerrures(n) Then
            If QuantitesFerrures(n) = 0 Then
                xlApp.Cells(i, 1) = "'" & ListePlanFerrures(m)
                xlApp.Cells(i, 2) = "Quantité nulle"
                i = i + 1
                Exit For
            ElseIf ListeIndiceFerrures(n) <> ListeIndiceFichier(m) Then
                xlApp.Cells(i, 1) = "'" & ListePlanFerrures(m)
                xlApp.Cells(i, 2) = "Indice Différent entre Nomenclature et Fichier"
                i = i + 1
                ActiveSheet.Cells(Numero_Ligne_Piece(n), 27).Activate
                r = 0
                For q = 1 To (ActiveSheet.Range("Fin_Colonne_item").Column - ActiveSheet.Cells(Numero_Ligne_Piece(n), 27).Column)
                    If ActiveCell.Offset(0, q).Value <> "" Then
                        ReDim Preserve Colonne_Item(r)
                        Colonne_Item(r) = ActiveCell.Offset(0, q).Column
                        r = r + 1
                    End If
                Next
                t = 0
                For s = 0 To UBound(Colonne_Item)
                    ReDim Preserve Liste_Item(t)
                    Liste_Item(t) = ActiveSheet.Range("Impression_des_titres").Cells(1, Colonne_Item(s))
                    t = t + 1
                Next
                xlApp.Cells(i - 1, 3).Value = Join(Liste_Item, ", ")
                Exit For

            End If
            Exit For
        End If
    Next
    If n > LongListeFerrures Then
        xlApp.Cells(i, 1) = "'" & ListePlanFerrures(m)
        xlApp.Cells(i, 2) = "Pas Présent dans Carnet de Ferrures"
        i = i + 1
    End If
Next

xlApp.Range("A:E").Columns.AutoFit

MsgBox "Terminer ?"
Workbooks(Nom_Fichier_Base).Sheets("Nomenclature").Range("Deb_colonne_ref").Activate
'Workbook_BeforeClose

End Sub

Désolé, il est très long mais je ne suis pas codeur de base j’optimise que très peu

CDT

SaintYor

Il y a une raison a vouloir l'enregistrer en Temp ?

sinon vire simplement la ligne

xlApp.Workbooks(1).SaveAs tempFile

'et tempFile = Environ("temp") & "\TempFile.xlsx"

Edit : Je n'avais pas vu ton 2eme message, je regarde ça

Alors comme mon dernier message, si tu n'as pas besoin de l'enregistrer, tu peux retirer la ligne au niveau de l'enregistrement ".SaveAs"

Tu as aussi cette version puisque tu as une question à la fin de ta procedure:
Remplace :

MsgBox "Terminer ?"

Par :

If MsgBox("Veux-tu supprimer le fichier temporaire ?", vbYesNo, "Terminé ?") = vbYes Then
    xlApp.Application.DisplayAlerts = False
    xlApp.ActiveWorkbook.Close True
    xlApp.Quit
    Kill tempFile
End If

Traduction, a la fin de ta macro quand tu auras le message "Veux-tu supprimer le fichier temporaire ?"
Si tu met Oui => ça ferme ton fichier temporaire et le supprime dans la foulée
Si non, le fichier temporaire reste

Mais a ma connaissance, il ne sera pas possible de dire a une macro contenu dans le fichier source qu'a la fermeture du fichier temporaire, il doit etre supprimé.

Merci pour ce retour.

C'est une bonne alternative. J'avais mis la Msgbox terminer ? à la fin pour me faire un point d’arrêt facilement visible mais ça pourrait le faire

Merci encore

CDT

Sinon est il possible de faire en sorte que le ficheir tempFile soit supprimer du temp apres enregistrer sous si enregistrer sous il y a ?

Mais la macro sera dans ton fichier source et non dans le fichier temporaire ce qui revient a mon 1er message avec

Kill "C:\TEMP\mon_fichier.xlsx"

A la différence que ce n'est plus un BeforeClose qu'on utilisera mais un AfterSave.

A moins que quelqu'un d'autre a une idée ? je seche

Bonjour SaintYor, Geof52,

Pourquoi ne pas fermer directement le fichier temporaire par le premier fichier. Lorsque cela sera nécessaire.

Voir ci-dessous. Dans un module2 il existe le code newXL ouvrant la nouvelle instance d'Excel incluant le fichier temporaire.

Sur la premier fichier le Range A1 (ou autre) va indiquer par le chiffre 2 (ou autre) que le fichier temporaire est créé puis ouvert.

Public tempFile
Dim xlApp As Object
Sub newXL()
tempFile = Environ("temp") & "\TempFileEssai.xlsx"
Range("A1") = 2
Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Add
xlApp.Workbooks(1).SaveAs tempFile
End Sub

Sub Clore()
xlApp.DisplayAlerts = False
xlApp.Workbooks(1).Close
Kill tempFile
xlApp.Quit
End Sub

Aussi, sur le premier fichier un événement sur la cellule A1 est inscrit. Par le code ci-dessous.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" And Range("A1") = 1 Then
    Module2.Clore
End If
End Sub

Ainsi lorsque est tapé ici en A1 le chiffre 1, le fichier temporaire est supprimé et la 2ième instance d'Excel est fermé.

Cela peut se faire aussi par un bouton sur le 1ier fichier.