XL 2016 Automatisation création d'image

[Colombine]

Bonjour à tous,
Après plusieurs heures d'essais, je viens vous demander une petite aide (toute honteuse de ne pas trouver par moi même !!).
J'ai une macro qui me transforme des code 128 en image ( macro ci jointe : mes codes sont dans un onglet "données" en colonne C) et me crée un fichier image par code.
Cela fonctionne très bien lorsque je la fais tourner avec ma touche F8.
Par contre dès que je lance la macro en automatique, mes fichiers images sont vides.
Il doit y avoir une petite coquille dans ma programmation mais je ne trouve pas quoi.
Pourriez-vous me donner un petit coup de main?
Nathalie

Sub Transforme_image_pourtest()
Dim S As Range
Dim nblig, i As Integer
Dim titre As Variant

Sheets("données").Select
nblig = ActiveSheet.UsedRange.Rows.Count
i = 2
For i = 2 To nblig + 1
titre = Cells(i, 1)
Set S = Sheets("données").Cells(i, 3)
S.CopyPicture
Workbooks.Add
With ActiveSheet.ChartObjects.Add(0, 0, S.Width, S.Height).Chart
.Paste
.Export "C:\" & titre & ".gif", "GIF"
End With
ActiveWorkbook.Close False
Next i
Application.ScreenUpdating = True
End Sub

 

[job75]

Bonjour Colombine,

Pas besoin de créer un nouveau document pour chaque image, voyez le fichier joint et cette macro :

Sub Transforme_image_pourtest()
Dim i As Long, titre As String, S As Range
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    For i = 1 To .Rows.Count
        titre = .Cells(i, 1)
        Set S = .Cells(i, 3)
        S.CopyPicture
        With .Parent.ChartObjects.Add(0, 0, S.Width, S.Height).Chart
            .Paste
            .Export ThisWorkbook.Path & "\" & titre & ".gif", "GIF"
            .Parent.Delete
        End With
    Next i
End With
End Sub

A+

 

[Colombine]

Bonjour,
Le programme est en effet plus simple que le mien par contre j'ai toujours le même problème. Lors de l'éxécution pas à pas ça fonctionne (et encore il y a des ratés) et dès que je lance la macro sur mon fichier complet, les gif crées sont vides.
Pour tester j'ai ajouté un bouton qui éxécute la macro, avez-vous le même problème ou cela vient de chez moi??
Merci pour votre aide.
Nathalie

 

[job75]

Pour tester j'ai ajouté un bouton qui éxécute la macro, avez-vous le même problème ou cela vient de chez moi??

Si je vous ai donné ce code c'est que chez moi (Win 10 64 bits - Excel 2013 32 bits) il n'y a aucun problème.

 

[Colombine]

ah mince moi c'est 2016 , le problème vient peut-être de là mais ça dépasse mes petites compétences.
Sniff

 

[job75]

J'ai vu sur le web qu'il y a en effet des problèmes avec Excel 2016.

Essayez cette macro dans le fichier (2) joint où une boucle Do/Loop permet d'attendre l'exécution du collage :

Sub Transforme_image_pourtest()
Dim i As Long, titre As String, S As Range
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    For i = 1 To .Rows.Count
        titre = .Cells(i, 1)
        Set S = .Cells(i, 3)
        S.CopyPicture
        With .Parent.ChartObjects.Add(0, 0, S.Width, S.Height).Chart
            Do While .Shapes.Count = 0 'boucle pour attendre l'exécution du collage
                .Paste
                DoEvents
            Loop
            .Export ThisWorkbook.Path & "\" & titre & ".gif", "GIF"
            .Parent.Delete
        End With
    Next i
End With
End Sub

 

[Colombine]

Super ça marche ! Merci beaucoup.
Heureusement que les forums existent sinon je finirais chauve mdr.
Bonne fin de journée à tous

 

[job75]

Je suis heureux que votre problème soit résolu.

Mais je suis curieux de nature, pourriez-vous avoir la gentillesse de tester ce fichier (3) avec la macro :

Sub Transforme_image_pourtest()
Dim i As Long, titre As String, S As Range, n&, mes$
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    For i = 1 To .Rows.Count
        titre = .Cells(i, 1)
        Set S = .Cells(i, 3)
        S.CopyPicture
        With .Parent.ChartObjects.Add(0, 0, S.Width, S.Height).Chart
            n = 0
            Do While .Shapes.Count = 0 'boucle pour attendre l'exécution du collage
                n = n + 1
                .Paste
                DoEvents
            Loop
            mes = mes & vbLf & "Image n° " & i & " - " & n & " boucle(s) - " & .Shapes.Count & " shape(s)"
            .Export ThisWorkbook.Path & "\" & titre & ".gif", "GIF"
            .Parent.Delete
        End With
    Next i
End With
MsgBox Mid(mes, 2)
End Sub

et de nous indiquer le texte exact du message que vous allez recevoir ?

Merci d'avance et A+

 

[job75]

Chez moi sur plusieurs essais je constate qu'une ou 2 images nécessitent 2 boucles, mais il n'y a toujours qu'une seule shape.

 

[patricktoulon]

bonjour
avec 2013 et 2016 sur W7 c'est encore pire
on a une latence (acces au clipbord et le chart) n'est pas accessible tout de suite a la création
ce qui
parfois génère des images blanches dans les fichier
pour solutionner ce problème je propose de créer le chart avant tout et surtout n'en créer qu'un
d'attendre que le contenu du clipboard soit valide en tant qu'image
de deleter le picture1 du chart a chaque tour
de veiller a bien vider le clip a chaque tour
sur un autre forum j'avais proposé ceci

Option Explicit
'https://www.developpez.net/forums/d1843265/logiciels/microsoft-office/excel/contribuez/copier-exporter-boucle-plusieur-plage-fichier-image-graph-methode-valable-excel-2016-a/


#If VBA7 Then
    Private Declare ptrsafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
#Else
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
#End If
Sub exporte_image()
    Dim plage As Range, chart1 As Object, i As Long, mesplage As Variant, hPicAvail As Long
    With Sheets("Feuil1")
        mesplage = Array("A2:K68", "A69:K180")
        Set chart1 = .ChartObjects.Add(0, 0, 1, 1).Chart
        For i = 0 To UBound(mesplage)
            With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With    'on vide le clipboard entre chaque copie pour tester vraiment le available
            Set plage = .Range(mesplage(i))
            With chart1
                With .Parent
                    .Width = plage.Width: .Height = plage.Height: .Left = plage.Width + 20:
                    plage.CopyPicture
                    Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(14): Loop While hPicAvail = 0    'Or (Timer - T) > 1000
                    .Select
                    Do: DoEvents: Loop Until .Chart.Pictures.Count = 0
                    .Chart.Paste
                    Do: DoEvents: Loop While .Chart.Pictures.Count = 0
                    .Chart.Export Environ("userprofile") & "\Desktop\image_" & i & ".jpg", "jpg"
                    .Chart.Pictures(1).Delete    'on delete a chaque fois l'image collée (important si les plages capturées sont differentes en terme de dimension)
                End With
            End With
        Next
        chart1.Parent.Delete
    End With
End Sub

dans ton model sans api on pourrait l'adapter comme suit

Sub Transforme_image_pourtest()
    Dim i As Long, titre As String, S As Range, chart1 As Object
    Application.ScreenUpdating = False
     With ActiveSheet.UsedRange
       Set chart1 = .Parent.ChartObjects.Add(0, 0, 1, 1).Chart    'on crée la chart avant tout et surtout on en crée qu'un !!!!
    For i = 1 To .Rows.Count
            titre = .Cells(i, 1)
            Set S = .Cells(i, 3)
            With chart1
                With .Parent
                    .Width = S.Width: .Height = S.Height: .Left = S.Offset(, 1) + 20:    'le left est en dehors de la plage/cellules copiée (ca evite de capturer avec une partie du chart)
                    S.CopyPicture
                    Do: DoEvents: Loop While .Chart.Pictures.Count > 0
                    .Chart.Paste
                    Do: DoEvents: Loop While .Chart.Pictures.Count = 0
                    .Chart.Export ThisWorkbook.Path & "\" & titre & ".gif", "GIF"
                    .Chart.Pictures(1).Delete    'on delete a chaque fois l'image collée (important si les plages capturées sont differentes en terme de dimension)
                End With
            End With
        Next i
    End With
    chart1.Parent.Delete
End Sub

 

[job75]

Bonjour patricktoulon,

Oui ne créer qu'une seule Chart au départ est probablement mieux en terme de rapidité, en terme d'efficacité je pense que ça ne change rien.

A+

 

[job75]

Cela dit chez moi la macro du post #10 (sans api) n'est pas plus rapide que celle du post #6 (1,1 seconde).

 

[Colombine]

merci à tous pour vos réponses et votre analyse, je viens de tester avec le fichier test(3), cela fonctionne bien. Le fenêtre de rapport d'éxécution m'indique avoir fait 3 ou 4 boucles pour chaque image.
Bonne journée à tous