Procédure de maj fonctionnant qu'en pas à pas

Le 15/06/2021 à 09:29

Bonjour,

je vous contact au sujet de ma procédure, qui ne fonctionne qu'en à pas à pas, si je lance l'exécution normalement, on dirait que les "call" ne s'exécutent pas.

Je ne pourrai pas mettre le classeur en entier pour des raisons confidentiels, mais je vais essayer de vous expliquer clairement la macro ci dessous

la fonction recherche qui est appelé au début fonctionne parfaitement et permet de récupérer les chemins des fichiers sources dans un onglet "dossier"

je viens alors récupérer les identifiants de pièces à l'intérieur des chemins qui vont me permettre de chercher selon les critères dans un fichier source les dates correspondantes. D'où les call MAJDATE qui permettent selon certains critère de récupérer ce qu'on veut. des boucles remontant de la ligne 20000 à 0 permettent de récupérer la date la plus ancienne selon les critères.

Sub recupOF()

Application.ScreenUpdating = False

Dim W As Long
Dim list2 As Variant
Dim list3 As Variant

Dim x As Range
Dim ligne As Integer
Dim colonne As Integer
Dim Li As Long
Dim Piece2 As Integer
Dim Piece As Integer
Dim Piece3 As Long

Dim j As Variant
Dim i As Variant
Dim inc As Integer
Dim dl As Variant
Dim tpath() As String
Dim Item As Variant
'Call RECHERCHED

 Set colonne1 = Range("I12:I1289")
' Range("H12:H1289")

Dim BoEcran As Boolean
BoEcran = Application.ScreenUpdating
Application.ScreenUpdating = False

'On met tout les liens sortis par la macro RECHERCHED dans un tableau
With Worksheets("Dossier")
    dl = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 5 To dl
        If Dir(.Cells(i, 1).Value) <> "" Then
            ReDim Preserve tpath(W)
            tpath(W) = .Cells(i, 1).Value
            W = W + 1

        End If
    Next i
End With

If W = 0 Then MsgBox "aucun fichier existant repertorié", 16: Exit Sub

'dimensionnement des tableaux stockant les donnée:ex:tdata(i,j);i étant le nombre de fichier,j le nombre données récupérer
 ReDim tnum(UBound(tpath), 1)
ReDim tOF(UBound(tpath), 1)
ReDim tREF(UBound(tpath), 1)
  ReDim tnum(UBound(tpath), 1)
  ReDim tcompt(UBound(tpath), 1)

v = 0
'récupération des données
For i = LBound(tpath) To UBound(tpath)

N = Mid(tpath(i), 139, 4)

 Sheets("Date").Activate
         Set G = Rows(1).Find(N, , xlValues, xlWhole)
         If G Is Nothing Then
        tnum(i, 1) = N
        Cells(10, 2) = v + 1
        tcompt(i, 1) = v + 1
        v = v + 1

    tnum(i, 1) = Mid(tpath(i), 139, 4)
    tOF(i, 1) = Mid(tpath(i), 144, 11)
    tREF(i, 1) = Mid(tpath(i), 156, 10)

End If
Next i

'.............restitution des données............................................;;
C1 = 3
C = 2
With ThisWorkbook.Sheets("Date")

Myrange = .Cells(1, Columns.Count).End(xlToLeft).Column

    For i = LBound(tpath) To UBound(tpath)
    If tcompt(i, 1) <> 0 Then
   .Cells(1, Myrange + C).Value = tnum(i, 1)
    .Cells(2, Myrange + C).Value = tREF(i, 1)
    .Cells(2, Myrange + C1).Value = tOF(i, 1)

          C = C + 2
          C1 = C1 + 2
    End If
    Next i
    End With
'une fois les OF récupérés, on récupère les dates de l'op80 et l'op110 à partir des OF
Call MAJDATE60
Application.Wait (Now + TimeValue("00:00:01"))
Call MAJDATE70
Application.Wait (Now + TimeValue("00:00:01"))
Call MAJDATE3D
Cells(10, 2).Clear
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Sub

Sub MAJDATE60()
'macro récupérant toute les dates de passages de la première à la dernière pièce de l'op80

 Application.ScreenUpdating = True
 Application.ScreenUpdating = False
Dim source, OF As Variant
Dim i, q, j, C, C1 As Integer
Dim AD As String
Dim dossier As Variant
Dim x As Variant

source = "chemin fichier source"

  ReDim tdata1(0, 500)
  ReDim tdata2(0, 500)
  ReDim tdata3(0, 500)
  ReDim tdata4(0, 500)

  i = 0

ThisWorkbook.Sheets("Date").Activate
q = Cells(1, Columns.Count).End(xlToLeft).Column
v = Cells(10, 2)
If v = 1 Then
q = q + 1
Else
v = v * 2 - 2
q = (q + 1) - v

End If

'récupération des données
 For j = 0 To 50
   ThisWorkbook.Sheets("Date").Activate
        AD = Cells(2, q).Value
         q = q + 2

    With Workbooks.Open(source, 0)
        With .Sheets(4)

       C = 20000
       While C <> 0:

        If Cells(C, 9) = "0060" And Cells(C, 5) = "6101" And AD = Cells(C, 28) Then

        tdata1(i, j) = .Cells(C, 2)

        C = 1
        End If
        C = C - 1
        Wend
        '''''''''''''''''''''''''
        Application.Wait (Now + TimeValue("00:00:01"))
        C = 20000
        While C <> 0:

        If Cells(C, 9) = "0060" And Cells(C, 5) = "6102" And AD = Cells(C, 28) Then

        tdata2(i, j) = .Cells(C, 2)

        C = 1
        End If
        C = C - 1
        Wend
        Application.Wait (Now + TimeValue("00:00:01"))
        ''''''''''''''''''
        C = 20000
        While C <> 0:

        If Cells(C, 9) = "0060" And Cells(C, 5) = "6103" And AD = Cells(C, 28) Then

        tdata3(i, j) = .Cells(C, 2)

        C = 1
        End If
        C = C - 1
        Wend

        End With

     End With

Next j

'.............restitution des données............................................;;

C = 0
ThisWorkbook.Sheets("Date").Activate
q = Cells(1, Columns.Count).End(xlToLeft).Column
v = Cells(10, 2)
If v = 1 Then
q = q + 1
Else
v = v * 2 - 2
q = (q + 1) - v
End If

Myrange = q - 1

With ThisWorkbook.Sheets("Date")

 For j = 0 To 50

    .Cells(4, Myrange).Offset(0, C).Value = tdata1(i, j)
    .Cells(5, Myrange).Offset(0, C).Value = tdata2(i, j)
    .Cells(6, Myrange).Offset(0, C).Value = tdata3(i, j)
    .Cells(3, Myrange).Offset(0, C).Value = 60

          C = C + 2

    Next j
    End With

End Sub

Sub MAJDATE70()
'macro récupérant toute les dates de passages de la première à la dernière pièce de l'op110

  Application.ScreenUpdating = True
 Application.ScreenUpdating = False

Dim source, OF As Variant
Dim i, q, j, C, C1 As Integer
Dim AD As String
Dim dossier As Variant
Dim x As Variant

source = "chemin fichier source"

  ReDim tdata1(0, 500)
  ReDim tdata2(0, 500)
  ReDim tdata3(0, 500)
  ReDim tdata4(0, 500)

  i = 0
ThisWorkbook.Sheets("Date").Activate
q = Cells(1, Columns.Count).End(xlToLeft).Column
v = Cells(10, 2)
If v = 1 Then
q = q + 1
Else
v = v * 2 - 2
q = (q + 1) - v
End If
'récupération des données

 For j = 0 To 50
    ThisWorkbook.Sheets("Date").Activate
        AD = Cells(2, q).Value
         q = q + 2

    With Workbooks.Open(source, 0)
        With .Sheets(4)

       C = 20000
       While C <> 0:
         If C = 9718 Then
        End If

        If Cells(C, 9) = "0070" And Cells(C, 5) = "6101" And AD = Cells(C, 28) Then

        tdata1(i, j) = .Cells(C, 2)

        C = 1
        End If
        C = C - 1
        Wend
        '''''''''''''''''''''''''
        C = 20000
        While C <> 0:

        If Cells(C, 9) = "0070" And Cells(C, 5) = "6102" And AD = Cells(C, 28) Then

        tdata2(i, j) = .Cells(C, 2)

        C = 1
        End If
        C = C - 1
        Wend
        ''''''''''''''''''
        C = 20000
        While C <> 0:

        If Cells(C, 9) = "0070" And Cells(C, 5) = "6103" And AD = Cells(C, 28) Then

        tdata3(i, j) = .Cells(C, 2)

        C = 1
        End If
        C = C - 1
        Wend

        End With

     End With

Next j

'.............restitution des données............................................;;
C = 1
ThisWorkbook.Sheets("Date").Activate
q = Cells(1, Columns.Count).End(xlToLeft).Column
v = Cells(10, 2)
If v = 1 Then
q = q + 1
Else
v = v * 2 - 2
q = (q + 1) - v
End If

Myrange = q - 1

With ThisWorkbook.Sheets("Date")

 For j = 0 To 50

    .Cells(4, Myrange).Offset(0, C).Value = tdata1(i, j)
    .Cells(5, Myrange).Offset(0, C).Value = tdata2(i, j)
    .Cells(6, Myrange).Offset(0, C).Value = tdata3(i, j)
    .Cells(3, Myrange).Offset(0, C).Value = 70

          C = C + 2

    Next j
    End With

End Sub
Sub MAJDATE3D()
'macro récupérant toute les dates de passages en 3D
 Application.ScreenUpdating = True
 Application.ScreenUpdating = False

Dim source, OF As Variant
Dim i, q, j, C, C1 As Integer
Dim AD As String
Dim dossier As Variant
Dim x As Variant

source = "chemin fichier source"

  ReDim tdata1(0, 500)
  ReDim tdata2(0, 500)
  ReDim tdata3(0, 500)
  ReDim tdata4(0, 500)

  i = 0
ThisWorkbook.Sheets("Date").Activate
q = Cells(1, Columns.Count).End(xlToLeft).Column
v = Cells(10, 2)
If v = 1 Then
q = q + 1
Else
v = v * 2 - 2
q = (q + 1) - v
End If

 For j = 0 To 50
ThisWorkbook.Sheets("Date").Activate
        AD = Cells(2, q).Value
         q = q + 2

    With Workbooks.Open(source, 0)
        With .Sheets(4)

       C = 20000
       While C <> 0:

        If Cells(C, 9) = "0100" And Cells(C, 5) = "6420" And AD = Cells(C, 28) Then

        tdata1(i, j) = .Cells(C, 2)

        C = 1
        End If
        C = C - 1
        Wend
        End With

     End With

Next j
  ActiveWorkbook.Close False

'.............restitution des données............................................;;
C = 0
ThisWorkbook.Sheets("Date").Activate
q = Cells(1, Columns.Count).End(xlToLeft).Column
v = Cells(10, 2)
If v = 1 Then
q = q + 1
Else
v = v * 2 - 2
q = (q + 1) - v
End If

Myrange = q - 1

With ThisWorkbook.Sheets("Date")

 For j = 0 To 50

    .Cells(7, Myrange).Offset(0, C).Value = tdata1(i, j)

          C = C + 2

    Next j
    End With

End Sub

Le 15/06/2021 à 11:14

Bonjour,

Code imbuvable : Fournir un fichier adapté.

Conseils :

Evitez les variables non déclarée.

Evitez les variables en une seule lettre. (C v...) ou indicée (C1, tdata1, tdata2...)

Souvent quand les procédures ne fonctionnent qu'en mode pas à pas c'est du à l'utilisation des Select : VBA ne sait pas à quelle feuille se rapportent les objets (Cells, Range)

A+

Le 15/06/2021 à 11:19

il n'y a aucun select

Le 15/06/2021 à 12:31

Select ou Activate : Même combat. A bannir !

A+

Le 15/06/2021 à 13:51

Merci pour ta réponse j'ai remplacé tout les "activate" avec des "with" et donc mis les points devant les lignes mais rien n'y fait, ça fonctionne correctement que en pas à pas, peut être une commande à conseiller pour forcer l'évènement ou autre?

Le 15/06/2021 à 14:28

Bonjour à tous,

Un coup d'oeil rapide en diagonale ...

Il y a plusieurs variables qui ne servent pas > pour les trouver > CTRL+F sur une variable> rechercher dans "Procédure en cours" ...

Il y a plusieurs variables non déclarées > tout au haut du module > ajoute Option Explicit > puis > menu "Débogage" > "Compiler VBAProject" ...

Remplacer les .Activate par des With et les points nécessaires > tu as mentionné que c'est fait ...

Dim i, q, j, C, C1 As Integer > i, q, j et C non typés sont considérés "Variant" > seul C1 est typé Integer ...

Je présume que ces codes sont dans un module et non dans une feuille ...

Attention aux "Application.ScreenUpdating qui se suivent (macro MAJDATE70 entre autres) ...

ric

Le 15/06/2021 à 14:39

tu as raison je vais d'abord faire un peu de ménage, merci pour ta réponse

Le 15/06/2021 à 15:01

je viens de prendre en compte toute tes remarques mais rien n'a changé..

Le 15/06/2021 à 15:02

c'est vraiment comme si les call ne se faisaient pas, le clear à la fin de récupOF ne s'effectue pas non plus

Le 15/06/2021 à 18:55

Bonjour à tous,

Désolé de ne pouvoir faire mieux sans fichier à tester ...

ric

Le 16/06/2021 à 08:06

Bonjour,

Attention effectivement à l'instruction "Application.ScreenUpdating = False". Elle est sans effet dans une exécution pas à pas mais elle peut parasiter l'exécution normale car elle ne rafraichit pas la situation des feuilles du classeur.

Le 16/06/2021 à 12:40

merci pour vos réponse, je prends en compte vos remarques. Du coup vous auriez pas un moyen de forcer l'exécution ? j'ai essayé de mettre des temporisations, de mettre des msgbox, j'ai aussi essayé la fonction run à la place des calls mais rien n'y fait.. ça fonctionne correctement que en pas à pas

Rechercher des sujets similaires à "procedure maj fonctionnant pas"