Tester si les fichiers sont ouverts VBA

Résolu/Fermé
xavier62000 Messages postés 65 Date d'inscription lundi 25 juin 2018 Statut Membre Dernière intervention 16 mars 2024 - 10 août 2018 à 12:29
xavier62000 Messages postés 65 Date d'inscription lundi 25 juin 2018 Statut Membre Dernière intervention 16 mars 2024 - 14 août 2018 à 14:00
Bonjour,

Je souhaite transférer des données de différents fichiers vers un seul dans le but de consolider mes données. Pour ce faire, j'ai crée un code dans ce sens et il fonctionne. Sauf, pour qu'il fonctionne sans bugg, il faut que tous les fichiers soit Fermés (à l'exception du fichier en cours d'utilisation biensûr et un autre appeler Essai). Je précise que tous les fichiers se trouvent dans le même répertoire.

Ainsi, pouvez m'écrire un petit bout de code dans le sens ou si tous les fichiers ne sont pas fermés

1°) Afficher dans une boite de dialogue les fichiers qui sont ouverts
2°) Sortir de la procédure


Sub LANCEMENT()
'avertissement pour autorisation de lancement
MyValue = MsgBox("Cette action va modifier les données affichées " & vbCrLf & "TOUS LES CLASSEURS CLUBS DOIVENT ETRE FERMES" & vbCrLf & "Cliquez sur oui pour continuer", _
vbYesNo + vbCritical + vbDefaultButton1, "AVERTISSEMENT")

If MyValue = vbYes Then
Call IMPORTATION
End If
End Sub

Merci d'avance
A voir également:

2 réponses

yg_be Messages postés 22694 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 17 avril 2024 1 471
Modifié le 10 août 2018 à 12:52
bonjour,
il est sans doute possible d'adapter le code d'importation pour ne pas avoir d'erreur si le fichier est ouvert.
ceci te donnera la liste des noms des fichiers ouverts (du même répertoire) et fera ce que tu demandes le cas échéant:
Dim wk As Workbook, list As String
For Each wk In Workbooks
    If wk.Name <> ThisWorkbook.Name And Left(wk.Name, 5) <> "Essai" And wk.Path = ThisWorkbook.Path Then
        list = list & vbCrLf & wk.Name
    End If
Next wk
If list <> "" Then
    Call MsgBox("merci de fermer:" & list, vbCritical, "FICHIERS OUVERTS")
    Exit Sub
End If
1
xavier62000 Messages postés 65 Date d'inscription lundi 25 juin 2018 Statut Membre Dernière intervention 16 mars 2024 2
14 août 2018 à 14:00
Merci beaucoup

pour la réponse, cela correspond exactement à ce que j'attendais.
0