Code OK pas à pas mais pas en automatique

Bonjour à tous,

J'ai un nouveau problème avec un programme que j'ai essayé d'optimiser. Je ne peux hélas pas transférer le fichier d'origine et les 2 autres issus d'une base de donnée auxquels je fais appel.

Ce dernier fonctionne en pas à pas mais pas en automatique.

Pourriez-vous m'aider s'il vous plait?

Sub Status_GDE()

Dim BenchName As String
Dim CompressorReady As String
Dim EndDate As String
Dim EndTestDate As Date
Dim EstimatedEndTestDate As Date
Dim i As Integer
Dim LIS As String
Dim o As Integer
Dim PlannedEndDate As Integer
Dim PlannedOnWeek As Integer
Dim PlannedOnYear As Integer
Dim PlannedStartDate As Integer
Dim Progression As Integer
Dim Proto_Availability As String
Dim RechDon As Range
Dim RechPla As Range
Dim ReportPlanif As String
Dim SendedReportDate As Date
Dim StartDate
Dim StartTestDate As Date
Dim TestResult As String
Dim TestStatus As Integer
Dim WeekDuration As Integer

'Ouvrir onglet "diag" du fichier "GDE_Donnees"
'   Onglet "diag" : Données enregistrées depuis le lancement de la GDE
'   Onglet "histo" : Données globale - informations erronées
Workbooks.Open Filename:="V:\gde\Compresseurs\GDE_Donnees.xlsx"
Worksheets("diag").Activate
ActiveSheet.AutoFilterMode = False
ActiveWorkbook.RefreshAll

'Ouvrir onglet "diag" du fichier "GDE_Donnees_Planification"
Workbooks.Open Filename:="V:\gde\Compresseurs\GDE_Donnees_Planification.xlsx"
ActiveSheet.AutoFilterMode = False
ActiveWorkbook.RefreshAll

'Retour sur le fichier DVP
ThisWorkbook.Activate

Worksheets("Design Verification Plan").Activate

ActiveSheet.AutoFilterMode = False

i = Range(Cells(7, 1), Cells(7, 1).End(xlDown)).Rows.Count

For o = 7 To i + 7
    If Cells(o, 8).Value = "Bench Test" And Cells(o, 18).Value <> "Canceled" And Cells(o, 18).Value <> "Report Done" And Cells(o, 9).Value <> "" Then
'Définir "Test Reference" recherché
            LIS = Cells(o, 9).Value
'Définir la zone de recherche
            Set RechDon = Workbooks("GDE_Donnees.xlsx").Sheets("diag").Columns(2).Find(LIS)
            Set RechPla = Workbooks("GDE_Donnees_Planification.xlsx").Sheets("GDE_Planification").Columns(1).Find(LIS)
'Si essai dans "GDE"
        If Not RechDon Is Nothing Then
        'Recherche paramètres GDE_Donnees
               StartTestDate = RechDon.Offset(0, 9).Value
               EstimatedEndTestDate = RechDon.Offset(0, 10).Value
               EndTestDate = RechDon.Offset(0, 11).Value
               TestResult = RechDon.Offset(0, 13).Value
               ReportPlanif = RechDon.Offset(0, 12).Value
               TestStatus = RechDon.Offset(0, 15).Value
               Progression = RechDon.Offset(0, 19).Value
               SendedReportDate = RechDon.Offset(0, 27).Value
               CompressorReady = RechDon.Offset(0, 46).Value
        'Recherche paramètres GDE_Planification
               BenchName = RechPla.Offset(0, 7).Value
               PlannedOnYear = RechPla.Offset(0, 4).Value
               PlannedOnWeek = RechPla.Offset(0, 3).Value
               WeekDuration = RechPla.Offset(0, 6).Value
        'Définition paramètres hors GDE
               PlannedStartDate = (PlannedOnYear - Application.RoundDown(PlannedOnYear / 100, 0) * 100) * 100 + PlannedOnWeek
            If StartTestDate <> 0 Then
               StartDate = (Year(StartTestDate) - Application.RoundDown(Year(StartTestDate) / 100, 0) * 100) * 100 + Application.WeekNum(StartTestDate, 21)
            End If
               PlannedEndDate = (Year(EstimatedEndTestDate) - Application.RoundDown(Year(EstimatedEndTestDate) / 100, 0) * 100) * 100 + Application.WeekNum(EstimatedEndTestDate, 21)
               EndDate = (Year(EndTestDate) - Application.RoundDown(Year(EndTestDate) / 100, 0) * 100) * 100 + Application.WeekNum(EndTestDate, 21)
'MàJ Proto Availability
            If CompressorReady = "TRUE" Then
                Proto_Availability = "Available"
                Else
                Proto_Availability = ""
            End If
            If Cells(o, 13).Value <> Proto_Availability Then
                Cells(o, 13).HorizontalAlignment = xlCenter
                Cells(o, 13).VerticalAlignment = xlCenter
                Cells(o, 13).Font.Bold = True
                Cells(o, 13).Font.ColorIndex = 3
                Cells(o, 13).Value = Proto_Availability
            End If
'MàJ Bench test
            If Cells(o, 14).Value <> BenchName Then
                Cells(o, 14).HorizontalAlignment = xlCenter
                Cells(o, 14).VerticalAlignment = xlCenter
                Cells(o, 14).Font.Bold = True
                Cells(o, 14).Font.ColorIndex = 3
                Cells(o, 14).Value = BenchName
            End If
'MàJ Start Date
            If StartTestDate <> 0 Then
                If Cells(o, 15).Value <> StartDate Then
                    Cells(o, 15).Value = StartDate
                    Cells(o, 15).HorizontalAlignment = xlCenter
                    Cells(o, 15).VerticalAlignment = xlCenter
                    Cells(o, 15).Font.Bold = True
                    Cells(o, 15).Font.ColorIndex = 3
                End If
            Else
                If PlannedStartDate <> 0 Then
                    If Cells(o, 15).Value <> PlannedStartDate Then
                        Cells(o, 15).Value = PlannedStartDate
                        Cells(o, 15).HorizontalAlignment = xlCenter
                        Cells(o, 15).VerticalAlignment = xlCenter
                        Cells(o, 15).Font.Bold = True
                        Cells(o, 15).Font.ColorIndex = 3
                    End If
                End If
            End If
'MàJ Achieved date
            If EndTestDate <> 0 Then
                If Cells(o, 16).Value <> EndDate Then
                    Cells(o, 16).Value = EndDate
                    Cells(o, 16).HorizontalAlignment = xlCenter
                    Cells(o, 16).VerticalAlignment = xlCenter
                    Cells(o, 16).Font.Bold = True
                    Cells(o, 16).Font.ColorIndex = 3
                End If
            Else
                If EstimatedEndTestDate <> 0 Then
                    If Cells(o, 16).Value <> PlannedEndDate Then
                        Cells(o, 16).Value = PlannedEndDate
                        Cells(o, 16).HorizontalAlignment = xlCenter
                        Cells(o, 16).VerticalAlignment = xlCenter
                        Cells(o, 16).Font.Bold = True
                        Cells(o, 16).Font.ColorIndex = 3
                    End If
                End If
            End If
'MàJ Duration
            If Cells(o, 17).Value <> WeekDuration Then
                Cells(o, 17).HorizontalAlignment = xlCenter
                Cells(o, 17).VerticalAlignment = xlCenter
                Cells(o, 17).Font.Bold = True
                Cells(o, 17).Font.ColorIndex = 3
                Cells(o, 17).Value = WeekDuration
            End If
'MàJ Request State
            Status = Application.VLookup(TestStatus, Worksheets("Inputs").Range("M2:N12"), 2, False)
            If Cells(o, 18).Value <> Status Then
                Cells(o, 18).HorizontalAlignment = xlCenter
                Cells(o, 18).VerticalAlignment = xlCenter
                Cells(o, 18).Font.Bold = True
                Cells(o, 18).Font.ColorIndex = 3
                Cells(o, 18).Value = Status
            End If
'MàJ Completion
                Cells(o, 19).Value = Progression / 100
'MàJ Completed date
            If TestStatus = 6 And Cells(o, 20).Value <> ReportPlanif Or TestStatus = 7 And Cells(o, 20).Value <> ReportPlanif Or TestStatus = 8 And Cells(o, 20).Value <> ReportPlanif Then
                Cells(o, 20).HorizontalAlignment = xlCenter
                Cells(o, 20).VerticalAlignment = xlCenter
                Cells(o, 20).Font.Bold = True
                Cells(o, 20).Font.ColorIndex = 3
                Cells(o, 20).Value = ReportPlanif
            Else
                If TestStatus = 9 And Cells(o, 20).Value <> SendedReportDate Then
                    Cells(o, 20).HorizontalAlignment = xlCenter
                    Cells(o, 20).VerticalAlignment = xlCenter
                    Cells(o, 20).Font.Bold = True
                    Cells(o, 20).Font.ColorIndex = 3
                    Cells(o, 20).Value = SendedReportDate
                    Cells(o, 20).NumberFormat = "m/d/yyyy"
                End If
            End If
 'MàJ Task Status
            If TestStatus = 9 And Cells(o, 21).Value <> TestResult Then
                Cells(o, 21).HorizontalAlignment = xlCenter
                Cells(o, 21).VerticalAlignment = xlCenter
                Cells(o, 21).Font.Bold = True
                Cells(o, 21).Font.ColorIndex = 3
                Cells(o, 21).Value = TestResult
            End If
        End If
    End If
Next

ActiveSheet.Range("A6:V6").AutoFilter Field:=18, Criteria1:="<>Canceled"

'Annule toutes les alertes Excel
Application.DisplayAlerts = False
Application.EnableEvents = False

Workbooks("GDE_Donnees.xlsx").Close SaveChanges:=False
Set wb_GDE = Nothing
Workbooks("GDE_Donnees_Planification.xlsx").Close SaveChanges:=False
Set wb_GDE = Nothing

'Restaure l'affichage des Alertes
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Bonjour,

Ne fonctionne pas en automatique OK, mais quel message est affiché et sur quelle ligne du programme ça bloque.

Merci de ta réponse, rien ne se bloque mais les informations complétées par le mode automatique sont érronées et différente du pas a pas.

Re,

Bizarre mais pour moi impossible de répondre sans voir fonctionner le programme. Désolé.

J'ai une piste,

Il semblerait que les infos issus de la base de donnée ne se mettent pas à jour malgré :

Workbooks("GDE_Donnees.xlsx").RefreshAll

Avez-vous une idée?

Application.CalculateUntilAsyncQueriesDone

En ajoutant ce code à la suite du RefreshAll, les fichiers ce mettent à jour.