Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

Anthonymctm

XLDnaute Occasionnel
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 :
VB: 
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
 
Solution
re
et la voila avec un garde fou avec un delay de 10 secondes avant abandon (a toi de mettre les secondes qui te paraissent raisonnables change 10 pour ce que tu veux )
VB: 
Dim pret As Boolean
Public Property Get presse_papier() As String
    presse_papier = "oui"
    On Error Resume Next
    presse_papier = CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")
    If Err.Number = 94 Then presse_papier = "non": Err.Clear
End Property



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 =...
Trier par date Trier par votes
C'est à dire avant abandon ? C'est un délai minimal ?
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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 😉
 
Vote positif 0 Vote négatif
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 ?
 
Vote positif 0 Vote négatif
patricktoulon à dit:
????????????????????????? 😵 😵 😵


quand je dis que c'est pas gagné 😛😛😛😛😛
Cliquez pour agrandir...
🙂
Je parlais de la fin :
VB: 
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
 
Vote positif 0 Vote négatif
Merde.. J'ai un message de dépassement de capacité sur la ligne T1 = timer

VB: 
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…