Saturation Macro (peut être mémoire saturée)

Question

Bonjour,

Je ne comprends pas,
ci-dessous j'ai créé une macro permettant de renommer des fichiers JPG situés dans un répertoire.
Lors du renommage le JPG s'affiche sur excel pour pouvoir ensuite le renommer.
Le code ci-dessous semble bien fonctionner, le renommage s'effectue correctement mais au bout d'un certain moment (au bout d'une centaine de JPG renommés) il semble que Excel sature apparemment et se bloque sur cette Feuille :Sheets("jpg3") .
Aucune cellule ne peut être sélectionnée, on ne peut rien écrire sur la cellule.
C'est comme si la mémoire RAM était trop saturée.

Est-ce bien un problème de mémoire à vider ou autre chose?
Je ne suis pas expert en macros
ni avec le code Doevents ou Application.CutCopyMode = False
Pouvez-vous m'aider à ce sujet?

Dim oShape As Shape
On Error Resume Next
    Set oShape = Sheets("cp87").Shapes("image")
    On Error GoTo 0

If oShape Is Nothing Then
       MsgBox "Vous ne pouvez pas renommer s'il n'y a pas de feuille!", vbCritical
       Set oShape = Nothing
       Exit Sub
    End If
    Set oShape = Nothing

Workbooks("TAGUEUR EXPORT.xls").Activate
Dim imgs As Object
Sheets("jpg3").Select
    Range("A1").Select
Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Selection.CopyPicture _
    Appearance:=xlScreen, _
    Format:=xlPicture
  Sheets("jpg3").Select
  Range("g14").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
Sheets("bv reponse").Select
ActiveSheet.DrawingObjects("picture 1").Copy
Sheets("jpg3").Select
    Range("G10").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
ActiveSheet.DrawingObjects("picture 1").Select
Selection.ShapeRange.IncrementLeft -15
Selection.ShapeRange.IncrementTop 5
Sheets("jpg3").Shapes.SelectAll
    Selection.Group
  Selection.CopyPicture _
    Appearance:=xlScreen, _
    Format:=xlPicture
 For Each imgs In Worksheets("jpg3").Shapes
     imgs.Delete
     Next
Sheets("cp87").Select
  Range("g60").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Sheets("jpg3").Select
  Cells.Select
  Selection.Clear
  Sheets("cp87").Select
Sheets("cp87").Shapes.SelectAll
    Selection.Group
  Selection.CopyPicture _
    Appearance:=xlScreen, _
    Format:=xlPicture
 For Each imgs In Worksheets("cp87").Shapes
     imgs.Delete
     Next
Range("a1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Calculation = xlCalculationManual
 Dim depeche As String
 Dim ferme As String
 Dim dates As String
 Dim page As String
 Dim jpg As String
 Dim bv As String

Dim AncienNom As String
 Dim nouveaunom As String

bv = " BV"
 depeche = " D"
 page = " F"
 jpg = ".jpg"
 Workbooks("TAGUEUR EXPORT.xls").Activate

Sheets("macros").Range("ac1") = Sheets("macros").Range("aa1") & Sheets("macros").Range("ab1") + 1 & jpg
   Sheets("macros").Range("z1") = Sheets("macros").Range("ac1")
   Sheets("macros").Range("ab1") = Sheets("macros").Range("ab1") + 1
   Sheets("tags").Range("b1") = Sheets("macros").Range("ac1")
   AncienNom = Sheets("macros").Range("a1") & Sheets("tags").Range("a1")
   nouveaunom = Sheets("macros").Range("a1") & Sheets("tags").Range("b1")

On Error Resume Next

Sheets("cp87").Select
    
 Dim sh1 As Shape, imag As Object
   Dim nomfichier21 As String
   
Dim ndf1 As String
Sheets("cp87").Select
nomfichier21 = Sheets("tags").Range("b1")
    For Each sh1 In ActiveSheet.Shapes
        If Left(sh1.Name, 1) <> "B" Then
            ndf1 = Sheets("macros").Range("a1") & nomfichier21
            sh1.CopyPicture xlScreen, xlPicture
            Set imag = ActiveSheet.ChartObjects.Add(0, 0, sh1.Width, sh1.Height)
            imag.Chart.Paste
            Application.CutCopyMode = False
            imag.Chart.Export ndf1
            imag.Delete
        End If
    Next sh1
    
Kill Sheets("macros").Range("a1") & Sheets("tags").Range("a1")

Sheets("tags2").Select
     Rows("1:1").Select
    Selection.Insert Shift:=xlDown
Sheets("tags").Select
    Range("b1").Copy
Sheets("tags2").Select
    Range("a1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("tags2").Range("b1") = Sheets("tags").Range("a1")
   Sheets("tags").Select
     Range("a1").Select
  Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Sheets("cp87").Select
    Me.Label6.Caption = ""
    Me.TextBox1.Value = Null
    Me.TextBox3.Value = Null
    Me.TextBox4.Value = Null
    Me.TextBox5.Value = Null
     Sheets("macros").Range("CD65536").End(xlUp).Offset(1, 0) = Sheets("macros").Range("a1") & Sheets("tags2").Range("A1")

Call ouvr
Application.Calculation = xlCalculationAutomatic
Unload Me
Me.Label7.Caption = Sheets("listetag").Range("z1").Value
tagbe.Caption = Sheets("tags").Range("a1").Value
Set imgs = Nothing
Set imag = Nothing
tagbe.Show
Set imgs = Nothing
Exit Sub

fin::

Sheets("cp87").Select
MsgBox "LE BV EST EN DOUBLE!"
Dim doublon As String
 doublon = MsgBox("voulez vous regarder la feuille en Doublon?", vbYesNo, "message bv")
 If doublon = vbYes Then
Dim nomfichier As String
nomfichier = Sheets("macros").Range("a1") & Sheets("macros").Range("z1")
Unload Me

ShellExecute 0, "open", nomfichier, "", "", 0
End If

Dim remplacer As String
remplacer = MsgBox("voulez vous supprimer le BV en Doublon?" & vbCrLf & vbCrLf & " OUI pour pour supprimer l'ancienne feuille." & vbCrLf & "NON pour supprimer cette feuille.", vbYesNoCancel, "message CP87")
 If remplacer = vbYes Then
 Dim fichier As String
fichier = Dir(Sheets("macros").Range("a1") & Sheets("macros").Range("z1"))
If Not fichier = "" Then
Kill (Sheets("macros").Range("a1") & Sheets("macros").Range("z1"))
 Sheets("tags2").Select
     Rows("1:1").Select
    Selection.Insert Shift:=xlDown
Sheets("tags").Select
    Range("a1").Copy
Sheets("tags2").Select
    Range("a1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 Sheets("tags").Select
     Range("a1").Select
  Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Sheets("tags2").Select
     Range("a1").Select
  Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Sheets("cp87").Select
    Call ouvr
MsgBox "Le BV en doublon a été supprimé."
Else
GoTo beugue
End If
 End If
 If remplacer = vbNo Then
 Dim fichier2 As String
fichier2 = Dir(Sheets("macros").Range("a1") & Sheets("macros").Range("z1"))
If Not fichier2 = "" Then
 Kill Sheets("macros").Range("a1") & Sheets("tags").Range("A1")

Sheets("tags2").Select
     Rows("1:1").Select
    Selection.Insert Shift:=xlDown
Sheets("tags").Select
    Range("a1").Copy
Sheets("tags2").Select
    Range("a1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 Sheets("tags").Select
     Range("a1").Select
  Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Sheets("tags2").Select
     Range("a1").Select
  Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Sheets("cp87").Select
    Call ouvr
 Else
MsgBox "ATTENTION!! le tableau beugue!" & vbCrLf & vbCrLf & "Rouvrez le dossier ou se trouve les tags à faire!", vbCritical
 perso.Show
 With perso.CommandButton1
        .BackColor = &HFF&
        .SetFocus
End With
End If
 End If
 Me.Label6.Caption = ""
    Me.TextBox1.Value = Null
    Me.TextBox3.Value = Null
    Me.TextBox4.Value = Null
    Me.TextBox5.Value = Null
    Set imgs = Nothing
 Exit Sub

beugue::
 MsgBox "ATTENTION!! le tableau beugue!" & vbCrLf & vbCrLf & "Rouvrez le dossier ou se trouve les tags à faire!", vbCritical
 perso.Show
 With perso.CommandButton1
        .BackColor = &HFF&
        .SetFocus
End With
Exit Sub
fin6::


     EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).
Explications disponibles ici : ICI 

Merci d'y penser dans tes prochains messages.

Patrice33740 · Answer

Bonjour,

La programmation exige beaucoup de rigueur, voici quelques conseils qui t'éviterons bien des déboires :

• commences tous les modules par Option Explicit, cela oblige à déclarer toutes les variables
• n'utilises jamais .Select, évites les objets actifs : Selection, Activecell, Activesheet, ... ;
• déclares les variables avec le type ad hoc (i.e. pas toutes en Variant)
• limites leur portée au strict nécessaire (i.e. locale, privée, publique ou globale) ;
• évites les références implicites(i.e. partielles), privilégies les références explicites (i.e. suffisament complètes),
--- par exemple, au lieu de = Cells(1,2) écrire = Worksheets(1).Cells(1,2).Value ;
• donc, précises toujours la feuille pour un objet Range (Cells, Rows, ...) et la propriété cible (Value, Text, ...)
• n'hésites pas à utiliser des variables pour représenter les objets, ça facilite l'écriture et la lecture du code,
--- par exemple :  Set MaPlage = Me.Range("B2:C8") ; 
• pour les mêmes raisons, n'hésites pas à utiliser aussi With et End With ;
• envisages toutes les valeurs potentielles des variables pour éviter les erreurs ;
• évites d'utiliser des propriétés ou méthodes d'objet héritées qui pourraient ne pas exister,
--- par exemple, au lieu de : Sheets(1).Range("A1") écrire Workheets(1).Range("A1"), 
    en effet l'objet Range n'appartient pas à Sheet mais à Worksheet ;
• éviter si possible d'utiliser le Presse-Papier, préfères la copie directe avec une destination ou pour copier les valeurs : .Value = .Value

Saturation Macro (peut être mémoire saturée)

1 réponse

Votre réponse

Discussions similaires

Newsletters