adaptation macro 2003 Í  2021

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

Merci Denis pour ton attention.

Le code donne le résultat escompté quand je fais un pas Í  pas F8.
Si je fais F5, l'image créée est vide.

J'ai mis un point d'arrêt Í  "With ActiveSheet.ChartObjects etc"
la suite en pas Í  pas est OK, pas si je continue avec F5.


j'ai mis un point d'arrêt Í  la ligne Numero=0
macro démarré avec F5, le cadre d'image existe mais est vide.

Remarque : avant de modifier "plage.CopyPicture (xlPrinter)"
j'ai eu, mais une seule fois, une erreur 1004 sur la ligne .paste

Il n'y a pas un paramètre pour paste, genre "colle soigneusement s'il te plait" ?

Si tu as une idée ...
Merci
J@@


'----------------------------------------
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 (xlPrinter) 'aussi essayé xlScreen même résultat
ActiveSheet.Paste
With ActiveSheet.ChartObjects.Add(0, 0, _
Selection.Width, Selection.Height).Chart
.Paste
Numero = 0 '<<<<====mis un point d'arrêt ici OK si le début en pas Í  pas détaillé

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 22/09/2022 Í  03:57, MichD a écrit :

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

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

Bonjour Denis,
c'est parfait. Merci.
J'ai juste ajouté la boucle qui sert Í  incrémenter un n° quand on fait plusieurs fois cette copie
sans écraser l'image initiale.
Voici le code final.

Encore Merci Denis.
Je crains d'avoir Í  te solliciter encore pour d'autres soucis d'adaptation de code de 2003 Í  2021.
Remarque : je regrette bien mes menus 2003. Ce ruban me parait peu souple ...
J@@

'==============================================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
Numero = 0
Nom = "C:UsersOrdre CDDesktopTest" & Numero & ".jpg"
While Dir(Nom) <> ""
Numero = Numero + 1
Nom = "D:MesDocumentsBureauTest" & Numero & ".jpg"
Wend

'Save chart to User's Desktop as JPG File
Cht.Chart.Export Nom

'Delete temporary Chart
Cht.Delete
ActiveShape.Delete
Application.ScreenUpdating = True
End Sub
'============================================= Le 22/09/2022 Í  15:08, MichD a écrit :

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