Bonjour,
D'ici quelques mois je vais passer la main sur des travaux que je
faisais de façon satisfaisante avec Excel 2000 (puis 2003 -je me suis
modernisé ...).
Ainsi je prépare un ordi Win11 avec Office 2021 (pas l'abonnement) et je
teste toutes les macros.
La suivante, si je la lance avec F5, me sort une image vide.
En pas Í pas détaillé F8, elle s'arrête Í la ligne "plage.CopyPicture"
avec un "point jaune". Impossible d'aller au delÍ .
Que faut-il faire, svp ?
Merci
J@@
***
Sub ExportFormatGif()
   Dim plage As Range
   Set plage = Application.InputBox(prompt:="Sélectionner votre
zone:(Ex.A1:B10) ", _
                                    Title:="Sélection de zone ",
Default:="$A$1", Type:=8)
   Application.ScreenUpdating = False
   Workbooks.Add
   plage.CopyPicture '''''''''''''''bloque ici
   ActiveSheet.Paste
   With ActiveSheet.ChartObjects.Add(0, 0, _
                                     Selection.Width,
Selection.Height).Chart
       .Paste
       numero = 0
       Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
       While Dir(Nom) <> ""
           numero = numero + 1
           Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
       Wend
       .Export Nom, "GIF"
   End With
   ActiveWorkbook.Close False
End Sub
****
Bonjour,
D'ici quelques mois je vais passer la main sur des travaux que je
faisais de façon satisfaisante avec Excel 2000 (puis 2003 -je me suis
modernisé ...).
Ainsi je prépare un ordi Win11 avec Office 2021 (pas l'abonnement) et je
teste toutes les macros.
La suivante, si je la lance avec F5, me sort une image vide.
En pas Í pas détaillé F8, elle s'arrête Í la ligne "plage.CopyPicture"
avec un "point jaune". Impossible d'aller au delÍ .
Que faut-il faire, svp ?
Merci
J@@
***
Sub ExportFormatGif()
   Dim plage As Range
   Set plage = Application.InputBox(prompt:="Sélectionner votre
zone:(Ex.A1:B10) ", _
                                    Title:="Sélection de zone ",
Default:="$A$1", Type:=8)
   Application.ScreenUpdating = False
   Workbooks.Add
   plage.CopyPicture '''''''''''''''bloque ici
   ActiveSheet.Paste
   With ActiveSheet.ChartObjects.Add(0, 0, _
                                     Selection.Width,
Selection.Height).Chart
       .Paste
       numero = 0
       Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
       While Dir(Nom) <> ""
           numero = numero + 1
           Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
       Wend
       .Export Nom, "GIF"
   End With
   ActiveWorkbook.Close False
End Sub
****
Bonjour,
D'ici quelques mois je vais passer la main sur des travaux que je
faisais de façon satisfaisante avec Excel 2000 (puis 2003 -je me suis
modernisé ...).
Ainsi je prépare un ordi Win11 avec Office 2021 (pas l'abonnement) et je
teste toutes les macros.
La suivante, si je la lance avec F5, me sort une image vide.
En pas Í pas détaillé F8, elle s'arrête Í la ligne "plage.CopyPicture"
avec un "point jaune". Impossible d'aller au delÍ .
Que faut-il faire, svp ?
Merci
J@@
***
Sub ExportFormatGif()
   Dim plage As Range
   Set plage = Application.InputBox(prompt:="Sélectionner votre
zone:(Ex.A1:B10) ", _
                                    Title:="Sélection de zone ",
Default:="$A$1", Type:=8)
   Application.ScreenUpdating = False
   Workbooks.Add
   plage.CopyPicture '''''''''''''''bloque ici
   ActiveSheet.Paste
   With ActiveSheet.ChartObjects.Add(0, 0, _
                                     Selection.Width,
Selection.Height).Chart
       .Paste
       numero = 0
       Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
       While Dir(Nom) <> ""
           numero = numero + 1
           Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
       Wend
       .Export Nom, "GIF"
   End With
   ActiveWorkbook.Close False
End Sub
****
Le 21/09/22 Í 20:16, Jarobasearobase a écrit :Bonjour,
D'ici quelques mois je vais passer la main sur des travaux que je faisais de façon satisfaisante
avec Excel 2000 (puis 2003 -je me suis modernisé ...).
Ainsi je prépare un ordi Win11 avec Office 2021 (pas l'abonnement) et je teste toutes les macros.
La suivante, si je la lance avec F5, me sort une image vide.
En pas Í pas détaillé F8, elle s'arrête Í la ligne "plage.CopyPicture" avec un "point jaune".
Impossible d'aller au delÍ .
Que faut-il faire, svp ?
Merci
J@@
***
Sub ExportFormatGif()
    Dim plage As Range
    Set plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                                     Title:="Sélection de zone ", Default:="$A$1", Type:=8)
    Application.ScreenUpdating = False
    Workbooks.Add
    plage.CopyPicture '''''''''''''''bloque ici
    ActiveSheet.Paste
    With ActiveSheet.ChartObjects.Add(0, 0, _
                                      Selection.Width, Selection.Height).Chart
        .Paste
        numero = 0
        Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
        While Dir(Nom) <> ""
            numero = numero + 1
            Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
        Wend
        .Export Nom, "GIF"
    End With
    ActiveWorkbook.Close False
End Sub
****
Bonjour,
J'ai testé le début de la procédure et la ligne de code que tu indiques ne cause aucun problème
(Excel 2016).
La méthode "Copypicture" peut utiliser au besoin deux paramètres, voir Í cette adresse :
https://learn.microsoft.com/fr-fr/office/vba/api/excel.range.copypicture?f1url=%3FappId%3DDev11IDEF1%26l%3Dfr-FR%26k%3Dk(vbaxl10.chm144106)%3Bk(TargetFrameworkMoniker-Office.Version%3Dv16)%26rd%3Dtrue
Essaie ce qui suit, ta procédure est peut-être victime d'un parasite!
'----------------------------------------
Sub ExportFormatGif()
Dim plage As Range, Numero As Long
Set plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                   Title:="Sélection de zone ", Default:="$A$1", Type:=8)
Application.ScreenUpdating = False
Workbooks.Add
plage.CopyPicture '''''''''''''''bloque ici
ActiveSheet.Paste
With ActiveSheet.ChartObjects.Add(0, 0, _
       Selection.Width, Selection.Height).Chart
   .Paste
    Numero = 0
   Nom = "D:MesDocumentsBureauTest" & Numero & ".gif"
       While Dir(Nom) <> ""
           Numero = Numero + 1
           Nom = "D:MesDocumentsBureauTest" & Numero & ".gif"
       Wend
       .Export Nom, "GIF"
End With
ActiveWorkbook.Close False
End Sub
'----------------------------------------
MichD
Le 21/09/22 Í 20:16, Jarobasearobase a écrit :
Bonjour,
D'ici quelques mois je vais passer la main sur des travaux que je faisais de façon satisfaisante
avec Excel 2000 (puis 2003 -je me suis modernisé ...).
Ainsi je prépare un ordi Win11 avec Office 2021 (pas l'abonnement) et je teste toutes les macros.
La suivante, si je la lance avec F5, me sort une image vide.
En pas Í pas détaillé F8, elle s'arrête Í la ligne "plage.CopyPicture" avec un "point jaune".
Impossible d'aller au delÍ .
Que faut-il faire, svp ?
Merci
J@@
***
Sub ExportFormatGif()
    Dim plage As Range
    Set plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                                     Title:="Sélection de zone ", Default:="$A$1", Type:=8)
    Application.ScreenUpdating = False
    Workbooks.Add
    plage.CopyPicture '''''''''''''''bloque ici
    ActiveSheet.Paste
    With ActiveSheet.ChartObjects.Add(0, 0, _
                                      Selection.Width, Selection.Height).Chart
        .Paste
        numero = 0
        Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
        While Dir(Nom) <> ""
            numero = numero + 1
            Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
        Wend
        .Export Nom, "GIF"
    End With
    ActiveWorkbook.Close False
End Sub
****
Bonjour,
J'ai testé le début de la procédure et la ligne de code que tu indiques ne cause aucun problème
(Excel 2016).
La méthode "Copypicture" peut utiliser au besoin deux paramètres, voir Í cette adresse :
https://learn.microsoft.com/fr-fr/office/vba/api/excel.range.copypicture?f1url=%3FappId%3DDev11IDEF1%26l%3Dfr-FR%26k%3Dk(vbaxl10.chm144106)%3Bk(TargetFrameworkMoniker-Office.Version%3Dv16)%26rd%3Dtrue
Essaie ce qui suit, ta procédure est peut-être victime d'un parasite!
'----------------------------------------
Sub ExportFormatGif()
Dim plage As Range, Numero As Long
Set plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                   Title:="Sélection de zone ", Default:="$A$1", Type:=8)
Application.ScreenUpdating = False
Workbooks.Add
plage.CopyPicture '''''''''''''''bloque ici
ActiveSheet.Paste
With ActiveSheet.ChartObjects.Add(0, 0, _
       Selection.Width, Selection.Height).Chart
   .Paste
    Numero = 0
   Nom = "D:MesDocumentsBureauTest" & Numero & ".gif"
       While Dir(Nom) <> ""
           Numero = Numero + 1
           Nom = "D:MesDocumentsBureauTest" & Numero & ".gif"
       Wend
       .Export Nom, "GIF"
End With
ActiveWorkbook.Close False
End Sub
'----------------------------------------
MichD
Le 21/09/22 Í 20:16, Jarobasearobase a écrit :Bonjour,
D'ici quelques mois je vais passer la main sur des travaux que je faisais de façon satisfaisante
avec Excel 2000 (puis 2003 -je me suis modernisé ...).
Ainsi je prépare un ordi Win11 avec Office 2021 (pas l'abonnement) et je teste toutes les macros.
La suivante, si je la lance avec F5, me sort une image vide.
En pas Í pas détaillé F8, elle s'arrête Í la ligne "plage.CopyPicture" avec un "point jaune".
Impossible d'aller au delÍ .
Que faut-il faire, svp ?
Merci
J@@
***
Sub ExportFormatGif()
    Dim plage As Range
    Set plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                                     Title:="Sélection de zone ", Default:="$A$1", Type:=8)
    Application.ScreenUpdating = False
    Workbooks.Add
    plage.CopyPicture '''''''''''''''bloque ici
    ActiveSheet.Paste
    With ActiveSheet.ChartObjects.Add(0, 0, _
                                      Selection.Width, Selection.Height).Chart
        .Paste
        numero = 0
        Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
        While Dir(Nom) <> ""
            numero = numero + 1
            Nom = "D:MesDocumentsBureauTest" & numero & ".gif"
        Wend
        .Export Nom, "GIF"
    End With
    ActiveWorkbook.Close False
End Sub
****
Bonjour,
J'ai testé le début de la procédure et la ligne de code que tu indiques ne cause aucun problème
(Excel 2016).
La méthode "Copypicture" peut utiliser au besoin deux paramètres, voir Í cette adresse :
https://learn.microsoft.com/fr-fr/office/vba/api/excel.range.copypicture?f1url=%3FappId%3DDev11IDEF1%26l%3Dfr-FR%26k%3Dk(vbaxl10.chm144106)%3Bk(TargetFrameworkMoniker-Office.Version%3Dv16)%26rd%3Dtrue
Essaie ce qui suit, ta procédure est peut-être victime d'un parasite!
'----------------------------------------
Sub ExportFormatGif()
Dim plage As Range, Numero As Long
Set plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                   Title:="Sélection de zone ", Default:="$A$1", Type:=8)
Application.ScreenUpdating = False
Workbooks.Add
plage.CopyPicture '''''''''''''''bloque ici
ActiveSheet.Paste
With ActiveSheet.ChartObjects.Add(0, 0, _
       Selection.Width, Selection.Height).Chart
   .Paste
    Numero = 0
   Nom = "D:MesDocumentsBureauTest" & Numero & ".gif"
       While Dir(Nom) <> ""
           Numero = Numero + 1
           Nom = "D:MesDocumentsBureauTest" & Numero & ".gif"
       Wend
       .Export Nom, "GIF"
End With
ActiveWorkbook.Close False
End Sub
'----------------------------------------
MichD
Bonjour,
Ceci devrait fonctionner. Reste Í insérer ta boucle, je n'ai pas
beaucoup compris ce que tu veux faire.
'==============================================> Sub SaveRangeAsPicture()
Dim Plage As Range, Numéro As Long, Nom As String
Dim Cht As ChartObject
Dim ActiveShape As Shape
Application.ScreenUpdating = False
On Error Resume Next
Set Plage = Application.InputBox(prompt:="Sélectionner votre
zone:(Ex.A1:B10) ", _
                   Title:="Sélection de zone ", Default:="$A$1", Type:=8)
If Err <> 0 Then
   Err = 0
   MsgBox "Aucune plage de cellules n'a été sélectionnée.", _
        vbInformation + vbOKOnly, "Opération annulée"
End If
'Copy/Paste Cell Range as a Picture
 Plage.Copy
 ActiveSheet.Pictures.Paste(link:úlse).Select
 Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
'Create a temporary chart object (same size as shape)
 Set Cht = ActiveSheet.ChartObjects.Add( _
   Left:¬tiveCell.Left, _
   Width:¬tiveShape.Width, _
   Top:¬tiveCell.Top, _
   Height:¬tiveShape.Height)
'Format temporary chart to have a transparent background
 Cht.ShapeRange.Fill.Visible = msoFalse
 Cht.ShapeRange.Line.Visible = msoFalse
'Copy/Paste Shape inside temporary chart
 ActiveShape.Copy
 Cht.Activate
 ActiveChart.Paste
 Numéro = 0
 Nom = "F:téléchargementsTest" & Numero & ".jpg"
'Save chart to User's Desktop as PNG File
 Cht.Chart.Export Nom
'Delete temporary Chart
 Cht.Delete
 ActiveShape.Delete
Application.ScreenUpdating = True
End Sub
'==============================================>
MichD
Bonjour,
Ceci devrait fonctionner. Reste Í insérer ta boucle, je n'ai pas
beaucoup compris ce que tu veux faire.
'==============================================> Sub SaveRangeAsPicture()
Dim Plage As Range, Numéro As Long, Nom As String
Dim Cht As ChartObject
Dim ActiveShape As Shape
Application.ScreenUpdating = False
On Error Resume Next
Set Plage = Application.InputBox(prompt:="Sélectionner votre
zone:(Ex.A1:B10) ", _
                   Title:="Sélection de zone ", Default:="$A$1", Type:=8)
If Err <> 0 Then
   Err = 0
   MsgBox "Aucune plage de cellules n'a été sélectionnée.", _
        vbInformation + vbOKOnly, "Opération annulée"
End If
'Copy/Paste Cell Range as a Picture
 Plage.Copy
 ActiveSheet.Pictures.Paste(link:úlse).Select
 Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
'Create a temporary chart object (same size as shape)
 Set Cht = ActiveSheet.ChartObjects.Add( _
   Left:¬tiveCell.Left, _
   Width:¬tiveShape.Width, _
   Top:¬tiveCell.Top, _
   Height:¬tiveShape.Height)
'Format temporary chart to have a transparent background
 Cht.ShapeRange.Fill.Visible = msoFalse
 Cht.ShapeRange.Line.Visible = msoFalse
'Copy/Paste Shape inside temporary chart
 ActiveShape.Copy
 Cht.Activate
 ActiveChart.Paste
 Numéro = 0
 Nom = "F:téléchargementsTest" & Numero & ".jpg"
'Save chart to User's Desktop as PNG File
 Cht.Chart.Export Nom
'Delete temporary Chart
 Cht.Delete
 ActiveShape.Delete
Application.ScreenUpdating = True
End Sub
'==============================================>
MichD
Bonjour,
Ceci devrait fonctionner. Reste Í insérer ta boucle, je n'ai pas
beaucoup compris ce que tu veux faire.
'==============================================> Sub SaveRangeAsPicture()
Dim Plage As Range, Numéro As Long, Nom As String
Dim Cht As ChartObject
Dim ActiveShape As Shape
Application.ScreenUpdating = False
On Error Resume Next
Set Plage = Application.InputBox(prompt:="Sélectionner votre
zone:(Ex.A1:B10) ", _
                   Title:="Sélection de zone ", Default:="$A$1", Type:=8)
If Err <> 0 Then
   Err = 0
   MsgBox "Aucune plage de cellules n'a été sélectionnée.", _
        vbInformation + vbOKOnly, "Opération annulée"
End If
'Copy/Paste Cell Range as a Picture
 Plage.Copy
 ActiveSheet.Pictures.Paste(link:úlse).Select
 Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
'Create a temporary chart object (same size as shape)
 Set Cht = ActiveSheet.ChartObjects.Add( _
   Left:¬tiveCell.Left, _
   Width:¬tiveShape.Width, _
   Top:¬tiveCell.Top, _
   Height:¬tiveShape.Height)
'Format temporary chart to have a transparent background
 Cht.ShapeRange.Fill.Visible = msoFalse
 Cht.ShapeRange.Line.Visible = msoFalse
'Copy/Paste Shape inside temporary chart
 ActiveShape.Copy
 Cht.Activate
 ActiveChart.Paste
 Numéro = 0
 Nom = "F:téléchargementsTest" & Numero & ".jpg"
'Save chart to User's Desktop as PNG File
 Cht.Chart.Export Nom
'Delete temporary Chart
 Cht.Delete
 ActiveShape.Delete
Application.ScreenUpdating = True
End Sub
'==============================================>
MichD
Je te faire remarquer que la procédure n'utilise pas un autre classeur pour créer l'image que tu
veux exporter.
MichD
Le 22/09/22 Í 20:59, MichD a écrit :Bonjour,
Ceci devrait fonctionner. Reste Í insérer ta boucle, je n'ai pas beaucoup compris ce que tu veux
faire.
'==============================================>> Sub SaveRangeAsPicture()
Dim Plage As Range, Numéro As Long, Nom As String
Dim Cht As ChartObject
Dim ActiveShape As Shape
Application.ScreenUpdating = False
On Error Resume Next
Set Plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                    Title:="Sélection de zone ", Default:="$A$1", Type:=8)
If Err <> 0 Then
    Err = 0
    MsgBox "Aucune plage de cellules n'a été sélectionnée.", _
         vbInformation + vbOKOnly, "Opération annulée"
End If
'Copy/Paste Cell Range as a Picture
  Plage.Copy
  ActiveSheet.Pictures.Paste(link:úlse).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
'Create a temporary chart object (same size as shape)
  Set Cht = ActiveSheet.ChartObjects.Add( _
    Left:¬tiveCell.Left, _
    Width:¬tiveShape.Width, _
    Top:¬tiveCell.Top, _
    Height:¬tiveShape.Height)
'Format temporary chart to have a transparent background
  Cht.ShapeRange.Fill.Visible = msoFalse
  Cht.ShapeRange.Line.Visible = msoFalse
'Copy/Paste Shape inside temporary chart
  ActiveShape.Copy
  Cht.Activate
  ActiveChart.Paste
  Numéro = 0
  Nom = "F:téléchargementsTest" & Numero & ".jpg"
'Save chart to User's Desktop as PNG File
  Cht.Chart.Export Nom
'Delete temporary Chart
  Cht.Delete
  ActiveShape.Delete
Application.ScreenUpdating = True
End Sub
'==============================================>>
MichD
Je te faire remarquer que la procédure n'utilise pas un autre classeur pour créer l'image que tu
veux exporter.
MichD
Le 22/09/22 Í 20:59, MichD a écrit :
Bonjour,
Ceci devrait fonctionner. Reste Í insérer ta boucle, je n'ai pas beaucoup compris ce que tu veux
faire.
'==============================================>> Sub SaveRangeAsPicture()
Dim Plage As Range, Numéro As Long, Nom As String
Dim Cht As ChartObject
Dim ActiveShape As Shape
Application.ScreenUpdating = False
On Error Resume Next
Set Plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                    Title:="Sélection de zone ", Default:="$A$1", Type:=8)
If Err <> 0 Then
    Err = 0
    MsgBox "Aucune plage de cellules n'a été sélectionnée.", _
         vbInformation + vbOKOnly, "Opération annulée"
End If
'Copy/Paste Cell Range as a Picture
  Plage.Copy
  ActiveSheet.Pictures.Paste(link:úlse).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
'Create a temporary chart object (same size as shape)
  Set Cht = ActiveSheet.ChartObjects.Add( _
    Left:¬tiveCell.Left, _
    Width:¬tiveShape.Width, _
    Top:¬tiveCell.Top, _
    Height:¬tiveShape.Height)
'Format temporary chart to have a transparent background
  Cht.ShapeRange.Fill.Visible = msoFalse
  Cht.ShapeRange.Line.Visible = msoFalse
'Copy/Paste Shape inside temporary chart
  ActiveShape.Copy
  Cht.Activate
  ActiveChart.Paste
  Numéro = 0
  Nom = "F:téléchargementsTest" & Numero & ".jpg"
'Save chart to User's Desktop as PNG File
  Cht.Chart.Export Nom
'Delete temporary Chart
  Cht.Delete
  ActiveShape.Delete
Application.ScreenUpdating = True
End Sub
'==============================================>>
MichD
Je te faire remarquer que la procédure n'utilise pas un autre classeur pour créer l'image que tu
veux exporter.
MichD
Le 22/09/22 Í 20:59, MichD a écrit :Bonjour,
Ceci devrait fonctionner. Reste Í insérer ta boucle, je n'ai pas beaucoup compris ce que tu veux
faire.
'==============================================>> Sub SaveRangeAsPicture()
Dim Plage As Range, Numéro As Long, Nom As String
Dim Cht As ChartObject
Dim ActiveShape As Shape
Application.ScreenUpdating = False
On Error Resume Next
Set Plage = Application.InputBox(prompt:="Sélectionner votre zone:(Ex.A1:B10) ", _
                    Title:="Sélection de zone ", Default:="$A$1", Type:=8)
If Err <> 0 Then
    Err = 0
    MsgBox "Aucune plage de cellules n'a été sélectionnée.", _
         vbInformation + vbOKOnly, "Opération annulée"
End If
'Copy/Paste Cell Range as a Picture
  Plage.Copy
  ActiveSheet.Pictures.Paste(link:úlse).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)
'Create a temporary chart object (same size as shape)
  Set Cht = ActiveSheet.ChartObjects.Add( _
    Left:¬tiveCell.Left, _
    Width:¬tiveShape.Width, _
    Top:¬tiveCell.Top, _
    Height:¬tiveShape.Height)
'Format temporary chart to have a transparent background
  Cht.ShapeRange.Fill.Visible = msoFalse
  Cht.ShapeRange.Line.Visible = msoFalse
'Copy/Paste Shape inside temporary chart
  ActiveShape.Copy
  Cht.Activate
  ActiveChart.Paste
  Numéro = 0
  Nom = "F:téléchargementsTest" & Numero & ".jpg"
'Save chart to User's Desktop as PNG File
  Cht.Chart.Export Nom
'Delete temporary Chart
  Cht.Delete
  ActiveShape.Delete
Application.ScreenUpdating = True
End Sub
'==============================================>>
MichD