[VBA] Ajouter un message si utilisateur n'a pas assez attendu

[Anthonymctm]

Bonjour Le forum,

Question un peu bête mais que je ne parviens pas à résoudre

Dans une partie de ma macro, je dois copier des données sur un autre logiciel.
Il y a facilement plus de 5 000 lignes générées par an, donc plus de 25 000 d'ici 5 ans.
La copie prend du temps, elle est indiqué en bas du logiciel en petit mais si on regarde pas on ne le voit pas.
Le soucis, vous l'aurez deviné, c'est que si on colle avant que ça ai finit de copier, j'ai des données incomplète (je me suis déjà fait avoir)
Actuellement ça prend 40s pour 10 000 lignes, donc 20s par année analysée.

J'arrive à modifier le timer pour que l'on calcule le temps d'attente mini, mais passé 3ans donc 60s d'attente j'arrive pas augmenter les minutes.

Faudrait pouvoir multiplier des durée mais je ne sais pas comment faire

Voici le bout de code en question :

DateDebutAnalyse = "22/12/2018"
Attente = DateDiff("yyyy", DateDebutAnalyse, Now) * 20
DébutAttente = Now
MsgBox "Avant de cliquer sur OK, copier les données de :" & vbCrLf & "Carnet des commandes clients > Analyse > Analyse globale (par cumul) > Double clique MO rélisée"
If Format(Now - DébutAttente, "hh:mm:ss") < "00:00:" & Attente Then
MsgBox "Attention, il est nécessaire d'attendre que la copie soit terminé" & vbCrLf & "Cela dure au moins 5sec par année annalysée"
End If

    With Sheets("Détails MO réel")
    .Select
    .Columns("A:O").ClearContents
    .Range("A1").Select
    .Paste 'on colle
    End With

 

[patricktoulon]

c'est bon on a fini?

 

[Anthonymctm]

c'est bon on a fini?

C'est à dire avant abandon ? C'est un délai minimal ?

Après j'aurais bien aimé savoir comment multiplier ou aditionner des durées, comme demandé initialement, je suis sur que ça me sera utile un jour ou l'autre.

 

[patricktoulon]

C'est à dire avant abandon ? C'est un délai minimal ?

puré c'est pas gagné hein
non c'est un delay max !!!
passer ce delay même si c'est pas prêt le moulin s’arrête et avorte l’opération ici en l'occurence le message de confirmation que toi tu a certainement remplacer par activesheet.paste

 

[Anthonymctm]

puré c'est pas gagné hein
non c'est un delay max !!!
passer ce delay même si c'est pas prêt le moulin s’arrête et avorte l’opération ici en l'occurence le message de confirmation que toi tu a certainement remplacer par activesheet.paste

Ah il faut être patient avec moi !
Je fais mon max
Ok, je vois, c'est si jamais ça se perd et que ça pense à tort que c'est jamais copié

Je demandais ça parcequ'à mon premier essai, ça a mis que c'était bon dès le début.. alors que ça l'était pas, depuis ça attend correctement.

 

[patricktoulon]

ca peut arriver les overcharge quand on copie des grosse quantités de données
le clip quand ça arrive te renverra d'office "non" indéfiniement
et tu risque le whitescreen ou greyscreen pour 2016 et 365 (ecran qui blanchi ou grisé)

donc a fin de ne pas te bloquer le garde fou veille

 

[Anthonymctm]

ca peut arriver les overcharge quand on copie des grosse quantités de données
le clip quand ça arrive te renverra d'office "non" indéfiniement
et tu risque le whitescreen ou greyscreen pour 2016 et 365 (ecran qui blanchi ou grisé)

donc a fin de ne pas te bloquer le garde fou veille

Oui je vois c'est bien, je rajoute ça et je t'envoie ça après.
Autre question débutant, je peux remplace le else par un end if, et suprimer le end if ?

 

[patricktoulon]

Autre question débutant, je peux remplace le else par un end if, et suprimer le end if ?

?????????????????????????

remplace le else par un end if, et suprimer le end if ?

quand je dis que c'est pas gagné

 

[Anthonymctm]

?????????????????????????


quand je dis que c'est pas gagné

Je parlais de la fin :

Sub test()
    Dim Texte$, T, T1
    T1 = Timer
    Do While presse_papier = "non"
        T = Timer: Do While Timer - T < 1: Loop
        If Timer - T1 > 10 Then Exit Do    'delay de 10 secondes avant d'avorter ; a modifier selon la tolérence souhaitée
    Loop
    If presse_papier = "non" Then
        MsgBox "le delay d'attente a été dépassé"
    End If ' A la place du else
        MsgBox "c'est pret à coller"
        MsgBox Right(presse_papier, 100)
        'activesheet.paste
'   End If
End Sub

 

[Anthonymctm]

Merde.. J'ai un message de dépassement de capacité sur la ligne T1 = timer

Option Explicit
Sub Actualisation()
Dim s, numcol1&, i&, x, A_wbook$, derligne%, MacroDebut As Date, T As Byte, T1 As Byte, DateDebutAnalyse As Date, DelaiMax As Byte
MacroDebut = Now
    ' indiquez l'ordre des colonnes par leur en-têtes
' ##### pour une colonne vide
Const OrdreTS = "Code cmde;Date cmde;Délai accepté;Réf. cde client;Nom client;Titre cmde;Avancement;Secteur d'activité"
Const OrdreTM = "Commande (code);Commande (titre);Client (nom);Commercial;Activité;CA devis;Mo devis;Tps devis;Achats devis;Dépenses devis;CA cde;Tps cde;Mo cde;Achats cde;Dépenses cde;Marge cde;CA réalisé;Tps réalisé;Mo réalisé;Achats réalisé;Engagé réalisé;Dépenses réalisé;Marge réalisé"

Application.ScreenUpdating = False

Worksheets("Liste des cmde client - export").Visible = True
Worksheets("Liste des cmde client").Visible = True
Worksheets("Resultat analyse - export").Visible = True
Worksheets("Resultat analyse").Visible = True
Worksheets("Cahier cmde client").Visible = True
Worksheets("Détails MO réel").Visible = True
'========================================================================================================
'========================  Liste des cmde client  =======================================================
'========================================================================================================
Listecmdeclient:
MsgBox "Avant de cliquer sur OK, copier les données de :" & vbCrLf & "Carnet des commandes clients (après filtration)"

    If IsClipboardEmpty = True Then
        If MsgBox("Erreur : Pas de données copiées", vbRetryCancel) = vbCancel Then   'On vérifie que le presse papier soit remplis sinon on sort
        Exit Sub
        Else: GoTo Listecmdeclient
        End If
    End If
    With Sheets("Liste des cmde client - export")
    .Select
    .Columns("A:H").ClearContents
    .Range("A1").Select
    .Paste 'on colle
End With
'============================== Supprimer collonnes ====================================
With Sheets("Liste des cmde client - export")   ' on vérifie que les en-têtes existent bien avant de tout chambouler
   s = Split(OrdreTS, ";")
   For Each x In s
      If x <> "#####" Then
         numcol1 = Application.IfError(Application.Match(x, .Rows(1), 0), 0)
         If numcol1 = 0 Then MsgBox "Erreur : Pas de colonne :" & x: Exit Sub
      End If
   Next x
   For i = UBound(s) To 0 Step -1 ' tous les en-têtes sont présents, on modifie l'ordre des colonnes
      .Columns(1).Insert xlShiftToRight
      If s(i) <> "#####" Then
         numcol1 = Application.IfError(Application.Match(s(i), .Rows(1), 0), 0)
         .Columns(numcol1).Copy .Columns(1)
      End If
   Next i
   .Range(Cells(1, UBound(s) + 2), Cells(1, .Columns.Count)).EntireColumn.Delete
End With

Sheets("Liste des cmde client - export").Cells.Copy Sheets("Liste des cmde client").Cells
Application.CutCopyMode = False

'======================================================================================================
'========================  Résultat analyse ===========================================================
'======================================================================================================
ResAnalyse:
MsgBox "Avant de cliquer sur OK, copier les données de :" & vbCrLf & "Carnet des commandes clients > Analyse > Liste des commandes"

    If IsClipboardEmpty = True Then
        If MsgBox("Erreur : Pas de données copiées", vbRetryCancel) = vbCancel Then   'On vérifie que le presse papier soit remplis sinon on sort
        Exit Sub
        Else: GoTo ResAnalyse
        End If
    End If
    With Sheets("Resultat analyse - export")
    .Select
    .Columns("A:Z").ClearContents
    .Range("A1").Select
    .Paste 'on colle
    End With
'============================== Supprimer collonnes ====================================
With Sheets("Resultat analyse - export")   ' on vérifie que les en-têtes existent bien avant de tout chambouler
   s = Split(OrdreTM, ";")
    For Each x In s
      If x <> "#####" Then
         numcol1 = Application.IfError(Application.Match(x, .Rows(1), 0), 0)
         If numcol1 = 0 Then MsgBox "Erreur : Pas de colonne :" & x: Exit Sub
      End If
    Next x
    For i = UBound(s) To 0 Step -1 ' tous les en-têtes sont présents, on modifie l'ordre des colonnes
      .Columns(1).Insert xlShiftToRight
      If s(i) <> "#####" Then
         numcol1 = Application.IfError(Application.Match(s(i), .Rows(1), 0), 0)
         .Columns(numcol1).Copy .Columns(1)
      End If
    Next i
   .Range(Cells(1, UBound(s) + 2), Cells(1, .Columns.Count)).EntireColumn.Delete
End With

Sheets("Resultat analyse - export").Cells.Copy Sheets("Resultat analyse").Cells
Application.CutCopyMode = False

'======================================================================================================
'======================== Cahier commande client===========================================================
'======================================================================================================
Cahiercmdeclient:
A_wbook = ActiveWorkbook.Name 'au cas où le nom du fichier change
Sheets("Cahier cmde client").Columns("A:Z").ClearContents
On Error GoTo OuvertureFichierErreur
Workbooks.Open "\\srv-dom\Commun\Commandes clients.xlsx", ReadOnly:=True
On Error GoTo 0
derligne = Range("C" & Rows.Count).End(xlUp).Row
    Windows("Commandes clients.xlsx").Activate
    On Error Resume Next ' au cas où il n'y ait pas de filtre a sortir
    ActiveSheet.ShowAllData
    On Error GoTo 0
    Range("C2:Q" & derligne).Copy
   
Workbooks(A_wbook).Worksheets("Cahier cmde client").Activate
Range("A1").PasteSpecial Paste:=xlPasteValues 'on colle en valeur pour ne pas perdre les numéro de cmde
Application.CutCopyMode = False
Workbooks("Commandes clients.xlsx").Close SaveChanges:=False

'======================================================================================================
'========================  Détails MO Réel ===========================================================
'======================================================================================================
Moreel:
Application.CutCopyMode = False
DateDebutAnalyse = "22/12/2018"
DelaiMax = DateDiff("yyyy", DateDebutAnalyse, Now) * 15 'Le délai max est de 15s par année analysée
MsgBox "Avant de cliquer sur OK, copier les données de :" & vbCrLf & "Carnet des commandes clients > Analyse > Analyse globale (par cumul) > Double clique MO rélisée"
   T1 = timer
    If IsClipboardEmpty = True Then
        If MsgBox("Erreur : Pas de données copiées", vbRetryCancel) = vbCancel Then   'On vérifie que le presse papier soit remplis sinon on sort
        Exit Sub
        Else: GoTo Moreel
        End If
    End If

    Do While presse_papier = "non"
        T = timer: Do While timer - T < 1: Loop
        If timer - T1 > DelaiMax Then Exit Do    'delay max avant d'avorter ; a modifier selon la tolérence souhaitée
    Loop
    If presse_papier = "non" Then 'si quand ça quitte c'est toujours non, c'est que c'est à cause du timer
        If MsgBox("Le delay d'attente a été dépassé, la copie a échoué", vbRetryCancel) = vbCancel Then
        Exit Sub
        Else: GoTo Moreel
        End If
    End If
    With Sheets("Détails MO réel")
    .Select
    .Columns("A:O").ClearContents
    .Range("A1").Select
    .Paste 'on colle
    End With
derligne = Range("T" & Rows.Count).End(xlUp).Row
Range("T3:V" & derligne).ClearContents
derligne = Range("A" & Rows.Count).End(xlUp).Row
Range("T2:V2").AutoFill Destination:=Range("T2:V" & derligne)
Sheets("TCD MO").PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
Application.CutCopyMode = False

'======================================================================================================
'======================== Analyse globale ===========================================================
'======================================================================================================
Sheets("Analyse globale").Select
Defiltrer
derligne = Range("A" & Rows.Count).End(xlUp).Row
Range("A4:AK" & derligne).ClearContents
Sheets("Liste des cmde client").Select
derligne = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Liste des cmde client").Range("A2:A" & derligne).Copy Sheets("Analyse globale").Range("A3") 'actualise la liste des cmdes
Sheets("Analyse globale").Select
derligne = Range("A" & Rows.Count).End(xlUp).Row
Range("B3:AK3").AutoFill Destination:=Range("B3:AK" & derligne)
    With Columns("A:A").Font
        .ColorIndex = xlAutomatic
        .Bold = True
    End With
Filtrer
'======================================================================================================
'======================== Fin ===========================================================
'======================================================================================================
Worksheets("Liste des cmde client - export").Visible = False
Worksheets("Liste des cmde client").Visible = False
Worksheets("Resultat analyse - export").Visible = False
Worksheets("Resultat analyse").Visible = False
Worksheets("Cahier cmde client").Visible = False
Worksheets("Détails MO réel").Visible = False

Sheets("TCD %").PivotTables("Tableau croisé dynamique2").PivotCache.Refresh
Sheets("TCD BE atelier").PivotTables("Tableau croisé dynamique2").PivotCache.Refresh
Sheets("TCD clients").PivotTables("Tableau croisé dynamique2").PivotCache.Refresh

Sheets("Analyse globale").Range("A1").Select

Application.ScreenUpdating = True
MsgBox "Traitement terminé" & vbCrLf & "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")

Exit Sub
OuvertureFichierErreur:
        If MsgBox("Erreur lors de l'ouverture de fichier...", vbRetryCancel) = vbCancel Then   'On vérifie que le presse papier soit remplis sinon on sort
        Exit Sub
        Else: GoTo Cahiercmdeclient
        End If
End Sub

 

[patricktoulon]

re
bonjour
trop de données à copier
ben tu est chocolat

 

[Anthonymctm]

re
bonjour
trop de données à copier
ben tu est chocolat

Pourtant ça marche si j'isole le bout de macro..
C'est possible de "décharger" des variable au fur et a mesure ?

 

[patricktoulon]

re
tout app a besoins de mémoire des que tu dépasse pour une raison ou une autre ben c'est la routine active qui plante
il faut qu'il y est suffisamment de mémoire dispo pour les données mais pour le fonctionnement aussi
et je serait pas étonné que tu soit borderline vu que ta demande est justement la quantité de données et donc ralentissement voir indispo du clipboard pendant le gloutonnage

 

[Anthonymctm]

C'est trop triste, chaque bloque de la macro fonctionne indépendemment.
Si je les mets chacun dans une macro ça permettra de décharger les variables ?

 

[Anthonymctm]

Ah le con..
J'avais essayer de brider la variable T et T1 as byte pour gagner de la vitesse... et en fait c'était pas bon visiblement. J'ai laisser en variable sans précision et ça fonctionne

 

[patricktoulon]

re
as double serait plus approprié