XL 2016 Problème d'ouverture complète d'un fichier - VBA

[otho van]

Bonjour,

j'ai un problème sur VBA que je ne parviens pas à régler en dépit de toutes mes tentatives et mes recherches sur différents forums


J'ai un fichier source dans lequel se trouve une macro qui fait appel un autre fichier
Le fichier cible est volumineux donc il met du temps à se charger, ma macro exécute l'instruction d'après avant l'ouverture complète du fichier

Le code plante au niveau du : stockage du nom de deux onglets du fichier cible dans les variables data_injection et data_nomination

j'ai beau mettre une temporisation, cela ne semble pas marcher.

Public wbkCap As Workbook
Public wbkd As Workbook
Public wbkDataFact As Workbook
Public data_facturation_2019 As String
Public data_facturation_2020 As String ''variables (classeur,onglets) CapelyPublic data_facturation_2019 As String

Public data_injection As Worksheet
Public data_nomiation As Worksheet

Public onglet_actif_capely As Worksheet ''l'onglet actif sur capely


Sub chercher_donnee_prod()


On Error GoTo FinMacro
Application.ScreenUpdating = False


Set wbkCap = ThisWorkbook ''le nom de classeur Capely est stocké dans WbkCap
Set onglet_actif_capely = ActiveSheet ''le nom d'onglet actif est stocké dans onglet_actif


Set ShtCap2019 = Worksheets("AL2019")
Set ShtCap2020 = Worksheets("AL2020")

Call Nombre_JPP2 '' compte le nbre de jours PP2
Call Remplir_JPP2 '' remplie le tableau avec les jours saisie dans capely
Call Remplir_HPP2 '' replie le tableau par les heures PP2
Call remplir_JHPP2
Call Affectation_var_fich_dataFacturation '' fonction qui affecter aux variables data_facturation le bon fichier

Select Case onglet_actif_capely.Cells(1, 1) '' selon l'AL, la macro va ouvrir le bon fichier data facturation et effectuer les calculs

Case 2019
Call Affectation_var_fich_dataFacturation '' fonction qui affecter aux var data_facturation le bon fichier
OuvrirFichier (data_facturation_2019)
Call Nombre_JPP2 '' compte le nbre de jours PP2
Call Remplir_JPP2 '' remplie le tableau avec les jours saisie dans capely
Call Remplir_HPP2 '' replie le tableau par les heures PP2
Call remplir_JHPP2
Set wbkDataFact = Workbooks("data_facturation_2019.xlsb")
Set data_injection = wbkDataFact.Worksheets("Data_Injecte")
Set data_nomination = wbkDataFact.Worksheets("Data_Nomination")

Case 2020
Call Affectation_var_fich_dataFacturation '' fonction qui affecter aux var data_facturation le bon fichier
OuvrirFichier (data_facturation_2020)
Call Nombre_JPP2 '' compte le nbre de jours PP2
Call Remplir_JPP2 '' remplie le tableau avec les jours saisie dans capely
Call Remplir_HPP2 '' replie le tableau par les heures PP2
Call remplir_JHPP2
Set wbkDataFact = Workbooks("data_facturation_2020.xlsb")
Set data_injection = wbkDataFact.Worksheets("Data_Injecte") --------------------------> le code plante ici, j'ai le meme probléme au niveau du case 2019
Set data_nomination = wbkDataFact.Worksheets("Data_Nomination")

end sub
Case Else

End Select

'FinMacro:
' Application.ScreenUpdating = True

End Sub

 

[sylvanu]

Bonjour Otho van,
Impossible de dire au vu du code pourquoi cette ligne coince. Si c'est réellement un problème de temps d'ouverture fichier.
Ci dessous une macro qui ouvre un fichier, puis vérifie qu'il est ouvert.
Si au bout de 10 secondes il n'est toujours pas ouvert alors un message apparait, et on sort de la macro :

Sub OuvertureFichier()
    Dim Nitération%, Nom_Fichier$
    Nom_Fichier = "Nom du fichier"                  ' Mettre à jour le nom du fichier
    Workbooks.Open Filename:=Nom_Fichier            ' Ouvre le fichier
    While FichOuvert(Nom_Fichier) = False           ' Si fichier pas ouvert
        Application.Wait Time + TimeSerial(0, 0, 1) ' Attente 1s.
        Nitération = Nitération + 1                 ' Compter les secondes
        If Nitération = 10 Then                     ' Si attente = 10s.
            MsgBox " Fichier toujours non ouvert après 10s."
            Exit Sub                                ' Sortie de la macro
        End If
    Wend
    ' Suite de la macro
    MsgBox " Fichier ouvert."
End Sub
Function FichOuvert(F As String) As Boolean
    ' Renvoie faux si fichier pas ouvert
    On Error Resume Next
    FichOuvert = Not Workbooks(F) Is Nothing
End Function

Pour essayer, modifier "Nom_Fichier" et vous verrez bien.