Ajouter condition ouverture fichier
Bonjour,
J'ai une macro dans lequel je fais appel à différents fichiers sources.
Pour que la macro fonctionne il faut donc que ces fichiers soient ouverts. C'est pourquoi certaines lignes de codes ont été créer pour les ouvrir. Malheureusement si certains de ces fichiers sont déjà ouverts au lancement de ma macro, il y a une erreur et la macro bug.
C'est pourquoi je voudrais savoir si il est possible d'ajouter une condition qui ouvre les fichiers seulement si ils ne sont pas déjà ouverts.
Est-ce possible de m'aider car je bloque....
Merci d'avance pour votre aide.
FloBru
Voici pour vous aider le code déjà en place :
'Définition des onglets de travail
Dim OIGeneral As Variant
Dim TTM As Variant
Dim ELIPS32 As Variant
Dim ELIPS33 As Variant
Dim ELIPS35 As Variant
'Ouverture fichiers ELIPS
Workbooks.Open Filename:="SA RFW-MISP Extract.xlsx"
Workbooks.Open Filename:="LR RFW-MISP Extract.xlsx"
Workbooks.Open Filename:="XW RFW-MISP Extract.xlsx"
Set OIGeneral = Workbooks("General.xlsm").Worksheets("OI General")
Set TTM = Workbooks("OR3M A320 Family General.xlsm").Worksheets("RFW-MISP")
Set ELIPS32 = Workbooks("SA RFW-MISP Extract.xlsx").Worksheets("MISSdb_extract")
Set ELIPS33 = Workbooks("LR RFW-MISP Extract.xlsx").Worksheets("MISSdb_extract")
Set ELIPS35 = Workbooks("XW RFW-MISP Extract.xlsx").Worksheets("MISSdb_extract")
TTM.Activate 'Activation par défaut de l'onglet RFW'MISP & TTM
derligne = TTM.Range("A" & Rows.Count).End(xlUp).Row 'Définition de la dernière ligne de la colonne A
For i = 2 To derligne
If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS32.Range("A:Z"), 25, False)) Then 'ELIPS A32
If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS33.Range("A:Z"), 25, False)) Then 'ELIPS A33
If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS35.Range("A:Z"), 25, False)) Then 'ELIPS A35
'MsgBox "The MISP/RFW " & TTM.Range("A" & i).Value & " is not in ELIPS extracts."
Else
TTM.Range("B" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS35.Range("A:Z"), 25, False)
End If
Else
TTM.Range("B" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS33.Range("A:Z"), 25, False)
End If
Next i
Workbooks("SA RFW-MISP Extract.xlsx").Close
Workbooks("LR RFW-MISP Extract.xlsx").Close
Workbooks("XW RFW-MISP Extract.xlsx").Close
End Sub
Bonjour FloBru
Tu peux utiliser une fonction personnalisée
Function FichierOuvert(Nom As String) As Boolean
Dim Test As String
On Error Resume Next
' Tester le contenu d'une cellule de la 1ère feuille du classeur
Test = "": Test = Workbooks(Nom).Sheets(1).Range("A1")
On Error GoTo 0
' Si aucune valeur
If Test = "" Then
' Le fichier n'est pas ouvert
FichierOuvert = False
Else ' Sinon
' Le fichier est déjà ouvert
FichierOuvert = True
End If
End Function
Et intégrer celle-ci dans ton code ou il manque un End IF d'ailleurs
Sub Test()
'Définition des onglets de travail
Dim OIGeneral As Variant
Dim TTM As Variant
Dim ELIPS32 As Variant
Dim ELIPS33 As Variant
Dim ELIPS35 As Variant
'Ouverture fichiers ELIPS
If Not FichierOuvert("SA RFW-MISP Extract.xlsx") Then Workbooks.Open Filename:="SA RFW-MISP Extract.xlsx"
If Not FichierOuvert("LR RFW-MISP Extract.xlsx") Then Workbooks.Open Filename:="LR RFW-MISP Extract.xlsx"
If Not FichierOuvert("XW RFW-MISP Extract.xlsx") Then Workbooks.Open Filename:="XW RFW-MISP Extract.xlsx"
Set OIGeneral = Workbooks("General.xlsm").Worksheets("OI General")
Set TTM = Workbooks("OR3M A320 Family General.xlsm").Worksheets("RFW-MISP")
Set ELIPS32 = Workbooks("SA RFW-MISP Extract.xlsx").Worksheets("MISSdb_extract")
Set ELIPS33 = Workbooks("LR RFW-MISP Extract.xlsx").Worksheets("MISSdb_extract")
Set ELIPS35 = Workbooks("XW RFW-MISP Extract.xlsx").Worksheets("MISSdb_extract")
TTM.Activate 'Activation par défaut de l'onglet RFW'MISP & TTM
derligne = TTM.Range("A" & Rows.Count).End(xlUp).Row 'Définition de la dernière ligne de la colonne A
For i = 2 To derligne
If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS32.Range("A:Z"), 25, False)) Then 'ELIPS A32
If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS33.Range("A:Z"), 25, False)) Then 'ELIPS A33
If IsError(Application.VLookup(TTM.Range("A" & i).Value, ELIPS35.Range("A:Z"), 25, False)) Then 'ELIPS A35
'MsgBox "The MISP/RFW " & TTM.Range("A" & i).Value & " is not in ELIPS extracts."
Else
TTM.Range("B" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS35.Range("A:Z"), 25, False)
End If
Else
TTM.Range("B" & i).Value = WorksheetFunction.VLookup(TTM.Range("A" & i).Value, ELIPS33.Range("A:Z"), 25, False)
End If
End If
Next i
Workbooks("SA RFW-MISP Extract.xlsx").Close
Workbooks("LR RFW-MISP Extract.xlsx").Close
Workbooks("XW RFW-MISP Extract.xlsx").Close
End Sub
A+
Bonjour Bruno,
Si j'me trompe pas, le forum Excel-Pratique est bien un lieu public, non ? ... alors la loi Évin, ça te dit quelque chose ?
dhany
Ah ! ... alors si tu te soignes avec des cigares cubains, t'as bien droit à une dérogation !
(c'est Fidel Castro qui va être content !)