Discussion :

[jpma75]

Bonjour,

Le code suivant ne fonctionne que si je l'exécute pas à pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Export_Gif()
Dim Plage As Range
Dim Répertoire As String
 
    Set Plage = Range("Plage_Stat")
    Répertoire = ThisWorkbook.Path
 
    Application.ScreenUpdating = False
    Workbooks.Add
    Plage.CopyPicture
    ActiveSheet.Paste
    With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart
        .Paste
        .Export Répertoire & "\Stats " & Format(Now, "yyyy.mm.dd - hh""h""nn") & ".gif", "gif"
    End With
    ActiveWorkbook.Close False
End Sub

Il y a donc quelque chose qui m'échappe. Une histoire de DoEvents ? Ou autre chose ?!

Par ailleurs, ça ne m'intéresse pas de stocker ce Gif ; je souhaiterais simplement qu'il s'ouvre quand on exécute cette procédure (quitte à ce qu'il soit supprimé du répertoire après lecture)

En vous remerciant d'avance pour vos lumières,
Cordialement,
jp

[ARTURO83]

Bonjour,

Pas de problèmes rencontrés en fonctionnement normal.
Ci-joint la procédure qui inclut l'ouverture du fichier GIF

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Export_Gif()
    Dim Plage As Range
    Dim Répertoire As String
 
    Dim Appli As Object
    Dim FichierGif As String
    Set Appli = CreateObject("Shell.Application")
 
    Set Plage = Range("Plage_Stat")
    Répertoire = ThisWorkbook.Path
 
    Application.ScreenUpdating = False
    Workbooks.Add
    Plage.CopyPicture
    ActiveSheet.Paste
    With ActiveSheet.ChartObjects.Add(0, 0, Selection.Width, Selection.Height).Chart
        .Paste
        .Export Répertoire & "\Stats " & Format(Now, "yyyy.mm.dd - hh""h""nn") & ".gif", "gif"
    End With
 
    'ouverture du fichier GIF
    FichierGif = Répertoire & "\Stats " & Format(Now, "yyyy.mm.dd - hh""h""nn") & ".gif"
    Appli.Open (FichierGif)
 
    Set Appli = Nothing
    ActiveWorkbook.Close False
End Sub

Pièce jointe 599762

Cdlt

[jpma75]

Bonjour,

Merci beaucoup pour cette proposition (et pour le fichier joint !!).

Même symptôme ! Ça fonctionne parfaitement "pas à pas" mais si j'exécute la procédure depuis le bouton dédié de ta feuille, ça génère une image vide (blanche, sans texte mais bordée) !

Mystère,

Cdt

PS : est-il indispensable de l'exporter (sur le bureau ou ailleurs) avant de l'afficher ?

[ARTURO83]

PS : est-il indispensable de l'exporter (sur le bureau ou ailleurs) avant de l'afficher ?

OUI

Si malgré cela, ça ne marche toujours pas, alors j'ignore d'où peut provenir le problème puisque ça fonctionne très bien chez moi.

Cdlt

[jpma75]

Bonjour,

Merci pour cette dernière précision.

Etant donné que j'ai lancé la procédure directement depuis le fichier joint (je n'ai pas transposé le code dans mon classeur), je ne vois pas que faire de plus.

Merci encore pour le classeur,

Cdt
jp

[ARTURO83]

Vous aviez demandé précédemment:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

est-il indispensable de l'exporter (sur le bureau ou ailleurs) avant de l'afficher ?

J'ai répondu: OUI

Mais visiblement d'après votre dernier post, vous n'avez pas suivi la consigne:

Etant donné que j'ai lancé la procédure directement depuis le fichier joint (je n'ai pas transposé le code dans mon classeur), je ne vois pas que faire de plus.

Essayez d'importer le fichier sur votre disque, ça peut avoir une incidence sur le résultat attendu.

[jpma75]

??

La question de savoir s'il fallait l'exporter sur le bureau concernait le Gif (pas le classeur).

Si votre classeur (original - sans modif) ne fonctionne pas sur mon PC SAUF si je lance la procédure pas à pas, je ne vois pas ce que l'intégration du code sur mon propre classeur peut changer mais je veux bien essayer.

En mode lancement de procédure, ça coince entre :

Plage.CopyPicture et ActiveSheet.Paste

L'image n'est pas copiée !

Cdt

[ARTURO83]

Je ne comprends pas, pourquoi ça marcherait chez moi et pas chez vous?

La preuve en vidéo

Pièce jointe 599829


Mettez un point d'arrêt à la ligne "Plage.CopyPicture" et relancez la procédure par le bouton, avant de continuer en pas à pas, assurez vous qu'un nouveau classeur à bien été créé.

[jpma75]

Bonsoir,

J'avais déjà essayé de mettre un point d'arrêt mais sans succès (j'avais aussi essayé avec un msgbox, un DoEvents, etc.).

Le nouveau classeur est bien créé (c'était déjà le cas).
La proc s'arrête sur le point d'arrêt mais si je presse F8, le nouveau classeur affiche en bas à gauche "étendre la sélection" (à chaque pression de F8) et la proc ne se poursuit pas... pour que F8 soit opérationnelle, je dois mettre le curseur devant l'instruction "Plage.CopyPicture". Et en pas à pas, ça marche parfaitement !!

Merci pour ta persévérance, en espérant qu'elle ne soit pas vaine.

Cdt
jp

[Umineko]

Bonjour à tous
ma proposition

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub ExportRangeToGIF2()
 
    Dim Répertoire As String, FichierGif As String
    Dim Plage  As Range
    Dim Appli  As Object
 
    Set Appli = CreateObject("Shell.Application")
 
    On Error GoTo Canceled
 
    Set Plage = Range("Plage_Stat")
    Répertoire = ThisWorkbook.Path
 
    Plage.Select
 
    With Selection
        FichierGif = Répertoire & "\Stats " & Format(Now, "yyyy.mm.dd - hh""h""nn") & ".gif"
        .CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        With ActiveSheet.ChartObjects.Add( _
             Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
            .Name = "TempChart"
            .Activate
        End With
    End With
 
    ActiveChart.Paste
 
    With ActiveSheet.ChartObjects("TempChart")
        .Chart.Export CStr(FichierGif)
        .Delete
    End With
 
    Appli.Open (FichierGif)
 
    Set Appli = Nothing
 
Canceled:
 
End Sub

[jpma75]

Bonjour,

Wow - ça marche !!!!

Je n'y croyais plus. Bravo ! Et un grand merci !

Cordialement,
jp