Image d'une plage dans un UserForm

[job75]

Bonsoir à tous,

Ce fil était intéressant :

https://www.excel-downloads.com/threads/erreur-dexecution-424.216992/

Je joins le fichier auquel j'ai abouti avec le fichier joint et cette macro :

Private Sub UserForm_Initialize()
Dim fichier$
MultiPage1.Value = 0 'par exemple la 1ère page
fichier = ThisWorkbook.Path & "\MonImage.jpg"
With Range("B1:H" & Range("B65000").End(xlUp).Row)
  .CopyPicture Format:=xlBitmap
  'création du fichier JPEG
  With ActiveSheet.ChartObjects.Add(0, 0, .Width + 5, .Height + 5).Chart
    .Paste
    .Export fichier, "JPG"
    .Parent.Delete
  End With
  'chargement de l'image et suppression du fichier
  Image1.Picture = LoadPicture(fichier)
  Kill fichier
  'dimensionnement
  Image1.Height = .Height + 5
  Image1.Width = .Width + 5
  Frame1.ScrollHeight = .Height + 5
  Frame1.ScrollWidth = .Width + 5
End With
End Sub

A+

 

[xhudi69]

Re : Image d'une plage dans un UserForm

Bonsoir job75, le Forum,

Vraiment interressant, merci pour ce code.

En PJ, une autre façon de voir, par contre,je ne sais pas si cela fonctionne en 2003 ou 2010, à voir......

@+ 😎

 

[job75]

Re : Image d'une plage dans un UserForm

Bonsoir xhudi69,

Ta solution est intéressante mais je la trouve un peu compliquée.

Pour tester les limites de mon fichier (1) j'ai ajouté des lignes au tableau.

Sur Excel 2003, l'image se crée jusqu'à la ligne 577 (a576), mais pas au delà.

A+

 

[job75]

Re : Image d'une plage dans un UserForm

Re,

Sur Excel 2010 l'image se crée jusqu'à à la ligne [Edit] 744, au-delà c'est un joyeux foutoir.

A+

 

[job75]

Re : Image d'une plage dans un UserForm

Bonjour le fil, le forum,

La macro du post #1 fonctionne avec un zoom à 100%.

Pour obtenir un résultat correct quel que soit le zoom :

Z = ActiveWindow.Zoom / 100 'coefficient de zoom
With ActiveSheet.ChartObjects.Add(0, 0, (.Width + 5) / Z, (.Height + 5) / Z).Chart

Fichier (2), testé sur Excel 2003, pas sur Excel 2010.

A+

 

[job75]

Re : Image d'une plage dans un UserForm

Re,

En fait pas besoin de contrôle Image, l'image peut être chargée directement dans le Frame :

Private Sub UserForm_Initialize()
Dim fichier$, Z#
MultiPage1.Value = 0 'par exemple la 1ère page
fichier = ThisWorkbook.Path & "\MonImage.jpg"
With Range("B1:H" & Range("B65000").End(xlUp).Row)
  .CopyPicture Format:=xlBitmap
  'création du fichier JPEG
  Z = ActiveWindow.Zoom / 100 'coefficient de zoom
  With ActiveSheet.ChartObjects.Add(0, 0, (.Width + 5) / Z, (.Height + 5) / Z).Chart
    .Paste
    .Export fichier, "JPG"
    .Parent.Delete
  End With
  'chargement de l'image et suppression du fichier
  Frame1.Picture = LoadPicture(fichier)
  Kill fichier
  Frame1.ScrollHeight = .Height + 5
  Frame1.ScrollWidth = .Width + 5
End With
End Sub

C'est d'ailleurs ce que fait xhudi69 🙂

Fichier (3).

A+

 

[job75]

Re : Image d'une plage dans un UserForm

Re,

J'ai été voir sur Excel 2010 ce que donnait le zoom.

Le résultat pour mes fichiers n'est pas le même et ce n'est guère fameux.

La solution de xhudi69 n'a pas de problème avec le zoom, quelle que soit la version.

A+

 

[job75]

Re : Image d'une plage dans un UserForm

Bonjour le forum,

Le plus simple est de revenir au fichier (1) en appliquant un zoom 100%.

Noter qu'on ne doit pas utiliser Application.ScreenUpdating = False.

Fichier (1 bis).

A+

 

[xhudi69]

Re : Image d'une plage dans un UserForm

Bonsoir job75 🙂 , le Forum

Pas eu trop le temps d'améliorer le fichier (mais je m'y mets), petite récréation avec l'entête de colonne "figée" comme un ListBox, à suivre................

@+ 😎

 

[job75]

Re : Image d'une plage dans un UserForm

Bonsoir xhudi69,

Très bien le 2ème Frame.

La 7ème colonne est quelque peu tronquée, surtout sur Excel 2003.

Quant aux bordures intérieures en pointillés, je pense que ta solution ne permet pas de les restituer.

A+

 

[Spitnolan08]

Re : Image d'une plage dans un UserForm

Bonsoir xhudi69,

Très bien le 2ème Frame.

La 7ème colonne est quelque peu tronquée, surtout sur Excel 2003.

Quant aux bordures intérieures en pointillés, je pense que ta solution ne permet pas de les restituer.

A+

Bonjour,
Merci à tous les deux pour cet exercice.
Sur Xl2019, la solution de Job75 ne fonctionne pas dans la dernière version, par contre ok dans la précédente. Mais si on part du dernier fichier, il faut enlever le contrôle image1 dans le frame d'affichage en page 6.
Celle de xhudi69 fonctionne très bien, par contre, un tantinet compliqué pour l'usage qui est le mien.
En tout cas super !

Edit : En fait les deux solutions de Job75, fonctionnent (celle en direct dans le frame ne fonctionne pas avec le scroll) mais il faut marquer une pause dans la macro, au niveau de paste par exemple, pour que le résultat s'affiche sinon page blanche ?!?

 

[job75]

Bonjour Spitnolan08,

Il est connu qu'avec les dernières versions d'Excel le collage (Paste) d'une image nécessite une boucle.

Le fichier du post #1 avec la macro :

Private Sub UserForm_Initialize()
Dim fichier$
MultiPage1.Value = 0 'par exemple la 1ère page
fichier = ThisWorkbook.Path & "\MonImage.jpg"
With Range("B1:H" & Range("B65000").End(xlUp).Row)
  .CopyPicture Format:=xlBitmap
  'création du fichier JPEG
  With Feuil2.ChartObjects.Add(0, 0, .Width + 5, .Height + 5).Chart
    Do
        .Paste
        DoEvents
    Loop While .Shapes.Count = 0 'boucle en attente du collage
    .Export fichier, "JPG"
    .Parent.Delete
  End With
  'chargement de l'image et suppression du fichier
  Image1.Picture = LoadPicture(fichier)
  Kill fichier
  'dimensionnement
  Image1.Height = .Height + 5
  Image1.Width = .Width + 5
  Frame1.ScrollHeight = .Height + 5
  Frame1.ScrollWidth = .Width + 5
End With
End Sub

A+

 

[Spitnolan08]

Re Job75, 👍

Il est connu qu'avec les dernières versions d'Excel le collage (Paste) d'une image nécessite une boucle.

Et bien je n'en savais rien....
Merci pour l'info.
Comme ça ton fichier est mis à jour ☺️😉
Sauf si tu l'avais déjà fait ailleurs.

 

[job75]

Comme ça ton fichier est mis à jour ☺️😉
Sauf si tu l'avais déjà fait ailleurs.

Oui en effet et depuis que je suis sur Excel 2019 j'ai fait plusieurs collages d'images avec une boucle.