Instabilité de code

Bonjour,

J'ai réalisé un code pour des signatures mais lors de la création de ces dernières, cela bug .

Lors du passage en pas à pas, il n'y a pas de soucis.

Les endroits ou le code s'arrête est signalé par une flèche.

Je peux fournir le fichier si besoin.

Merci d'avance

Private Sub Signature_Click()

Dim Plage As Range
Dim fichier As String

Application.ScreenUpdating = False

With Sheets("GESTION")
    .Unprotect (Sheets("GESTION").Range("B3").Value)
    .Activate
    .Range("M2").Value = ComboBox2 & " " & TextBox1 & " " & TextBox2
    .Range("M3").Value = TextBox5
    .Range("M4").Value = ComboBox3
    '__________________________________________________
    'ajouter l'image de la Cie
    '__________________________________________________
    Set Plage = .Range("M2:P4")

    Plage.VerticalAlignment = xlCenter
    Plage.HorizontalAlignment = xlCenter
--->    Plage.CopyPicture xlScreen, xlBitmap
--->    Plage.PasteSpecial
    .Shapes(.Shapes.Count).Copy

    With .ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height).Chart
        .ChartArea.Select

        .Paste
        .Export (ThisWorkbook.Path & "\" & "signaturetemp" & ".jpg")
    End With

    Gestion_personnel.Image1.Picture = LoadPicture(ThisWorkbook.Path & "\" & "signaturetemp" & ".jpg")

    .Shapes(.Shapes.Count).Delete
    .Shapes(.Shapes.Count).Delete
    .Protect (Sheets("GESTION").Range("B3").Value)
End With

Set Plage = Nothing

Kill ThisWorkbook.Path & "\" & "signaturetemp" & ".jpg"

Sheets("PERSONNEL DESIGNE").Activate

CheckBox3 = True

Application.ScreenUpdating = True

End Sub

Bonsoir,

Merci de joindre le fichier anonymisé SVP

A+

bonjour Bruno, Arno51,

il faut ajouter un delai (200-500 msecondes) à ces endroits, mais c'est plus facile à expliquer avec un fichier.

Merci à tous les deux je prépare le fichier et j'envoie ça demain.

Merci de la réponse rapide 😁

Vous pouvez commencer avec plusieurs "DoEvents" après ces 2 lignes

--->    Plage.CopyPicture xlScreen, xlBitmap
DoEvents:DoEvents:DoEvents:DoEvents:DoEvents:DoEvents:DoEvents
--->    Plage.PasteSpecial
DoEvents:DoEvents:DoEvents:DoEvents:DoEvents:DoEvents:DoEvents

Bonsoir,

Juste un petit rappel à BsAlv

Imbrications de DoEvents

Utiliser trop d'instructions DoEvents imbriquées peut épuiser l'espace de pile et donc générer un message d'erreur « espace de pile insuffisant ». Cette erreur fait référence à l'espace de pile d'application attribué à la demande de l'application.
De la même manière, utiliser DoEvents en boucle ne peut que solliciter abusivement le processeur et en provoquer la surchauffe. Il ne s'agit d'augmentation de mémoire utilisée, mais de sollicitation abusive.

Quantité de traitements

DoEvents a tendance à ralentir le système, car il augmente la quantité de traitement que le système doit effectuer pour chaque message. Vous devez n'utiliser DoEvents que lorsque cela est nécessaire, et « l'arrêter » dès que possible.

re,

et pourtant, la solution sera de ralentir le programme pendant ca. 200 msec avec x DoEvents ..., donc on écrit x DoEvents ou on le fait dans un boucle pendant x milliseconds. Mais si vous avez une autre méthode .... (avec Wait n'est pas si précis)

'....
Plage.CopyPicture xlScreen, xlBitmap
Ralentir
Plage.PasteSpecial
Ralentir
'.....

Sub Ralentir()
t = Timer
t1 = Timer + 0.25 'delai de 250 millisecondes (à modifier)
Do
DoEvents
Loop While t <= Timer And Timer < t1
End Sub

re,

je me rappèle une méthode avec "On error" dans un boucle, sans ce "DoEvents" et donc dès que la ligne est exécutée sans erreur, on poursuit avec la suivante. Donc demain, avec un fichier ...

Bonjour à tous,

ce que je fais :

Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long ' xl 64 bits
'Timer milli seconde
Sub TimerMS(delai)
    Dim TP As Long, i As Long
    TP = GetTickCount
    Do While TP + delai > GetTickCount
        i = i + 1
        If i = 50000 Then i = 0: DoEvents ' environ tous les 1/10 secondes, dépend du processeur
    Loop
End Sub

'Appel :
Sub test()
    TimerMS 600
End Sub

eric

re et bonjour eriiic,

je ne me rappèle plus 100%, mais c'était quelque chose comme ceci et c'est sans delai, juste "error handling"

          Plage.VerticalAlignment = xlCenter
          Plage.HorizontalAlignment = xlCenter

1:
          On Error Resume Next
          DoEvents
          Plage.CopyPicture xlScreen, xlBitmap
          If Err.Number = 0 Then cnt = 0 Else b1 = True: cnt = cnt + 1: If cnt > 100 Then MsgBox "fatal": Exit Sub
          If cnt > 0 Then GoTo 1

2:
          On Error Resume Next
          DoEvents
          Plage.PasteSpecial
          If Err.Number = 0 Then cnt = 0 Else b1 = True: cnt = cnt + 1: If cnt > 100 Then MsgBox "fatal": Exit Sub
          If cnt > 0 Then GoTo 2

          .Shapes(.Shapes.Count).Copy

Bonjour BrunoM45,

Voici le fichier utilisé vierge, tout se passe dans l'onglet "personnel désigné" en haut à droite le bouton gestion du personnel. Le problème survivant à la création de la signature.

J'essaie les autres méthode mais j'ai une erreur avec celui de eriiic sur la ligne :

Declare Ptrsafe function

Bonjour,

ceci a fonctionné chez moi :

    Plage.CopyPicture Format:=xlPicture
    Set newPlage = Plage.Offset(4)
    newPlage.PasteSpecial

@ bientôt

LouReeD

Pour Eriic,

J'ai cette déclaration qui tombe :

Désolé je ne suis pas expert, donc je ne comprend pas trop :(

Merci LouReeD,

J'ai testé, effectivement pas de soucis sur une première utilisation mais si je les enchaine en créant plusieurs personnes, le code fini par me mettre une erreur, qui finit par passer au pas à pas :(

J'ai fais ce genre de chose : mettre un image de cellule dans un USF, mais je n'utilise pas le même code. Parcontre après chaque création d'image et import dans le USF je "kill" l'image.

Peut être est-ce cela la différence, essayez de mettre des "nothing" afin de vider la mémoire...

@ bientôt

LouReeD

Salut,

Et si au lieux de faire des copier coller, tu utilisais vbaImageList dans le formulaire c'est beaucoup plus pratique. Si tu es sur un Excel 32bits bien entendu

https://10tec.com/imagelist-ocx/

Bonjour,

j'ai une erreur avec celui de eriiic sur la ligne : Declare Ptrsafe function

tu dois avoir installé la version 32 bits d'Office. Supprime Ptrsafe

J'ai cette déclaration qui tombe : Erreur de compilation

Je ne vois pas pourquoi cette erreur. Les déclarations des variables sont banales. Peut-être la même cause qu'au-dessus, mais le message est inapproprié (?)

Cette petite fonction sert à insérer des tempos là où elles semblent nécessaires pour permettre à vba d'attendre les réponses à certaines actions un peu lentes.
eric

Jean-Paul, non je suis sur une version 64bit (je viens de vérifier) :(

Eriiic, non version 64bit pourtant, je vais réessayer aussi. je ne lâche rien.

Merci pour le coup de main et bonne fête de fin d'année si je ne reviens pas d'ici là.

Tu copies-colles le code dans un module standard d'un classeur vierge pour tester ?
J'ai dans l'idée que ton erreur est due à d'autres lignes...
eric

Bon j'ai testé la proposition Do event de BsAlv. Bon je réussi à faire 5 code d'affilé avant que ça ne saute.

Y a t'il un moyen de supprimer la mémoire juste après des copier coller car c'est peut être çà qui gêne dans le temps.

merci encore à tous pour l'aide apportée.