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

Salut dhany

Oui mais là, je ne fume pas... je me soigne

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 !)

Rechercher des sujets similaires à "ajouter condition ouverture fichier"