Xls to Jpg

[speedball]

Bonjour

Je voudrais savoir si il est possible d'enregistrer ou d'exporter une feuille en jpg.

Merci

 

[MichelXld]

bonjour Speedball

j'espere que cette macro pourra t'aider

Sub conversion_Feuille_Image()
Dim Ligne As Integer, Colonne As Integer

Application.ScreenUpdating = False
Feuil1.UsedRange.CopyPicture
Feuil1.Paste

Ligne = Feuil1.Cells.Find('*', Feuil1.Range('A1'), SearchDirection:=xlPrevious).Row + 1
Colonne = Feuil1.Cells.Find('*', Feuil1.Range('A1'), SearchDirection:=xlPrevious).Column + 1

With Feuil1.ChartObjects.Add(0, 0, Cells(Ligne, Colonne).Left, Cells(Ligne, Colonne).Top).Chart
.Paste
.Export ThisWorkbook.Path & '\\monImage.jpg', 'JPG'
End With

With Feuil1
.ChartObjects(Feuil1.ChartObjects.Count).Delete
.Shapes(Feuil1.Shapes.Count).Delete
End With

Application.ScreenUpdating = True
End Sub

bonne journée
MichelXld

 

[usul]

ou une impression avec l'imprimante virtuelle de pdfcreator et un enregistrement en jpg

 

[speedball]

D'abord merci pour votre aide

Ma feuille s'appelle saison, j'ai remplacé tous les feuil1 par saison
Je ne suis pas sur d'avoir fait.
J'ai export en jpg, mais l'image est toute compacter en horizontale mais en verticale.
je voudrais que l'export ce face que sur la zone d'impression ou de A1 à K63

Merci de me dire si j'ai fait une bétise

A+

 

[MichelXld]

rebonjour Speedball , bonjour Usul

tu peux tester cette adaptation

Sub conversion_Feuille_Image_V02()
Application.ScreenUpdating = False
Sheets('Saison').UsedRange.CopyPicture
Sheets('Saison').Paste

With Sheets('Saison').ChartObjects.Add(0, 0, Sheets('Saison').Range('K64').Left, _
Sheets('Saison').Range('K64').Top).Chart
.Paste
.Export ThisWorkbook.Path & '\\monImage.jpg', 'JPG'
End With

With Sheets('Saison')
.ChartObjects(Sheets('Saison').ChartObjects.Count).Delete
.Shapes(Sheets('Saison').Shapes.Count).Delete
End With

Application.ScreenUpdating = True
End Sub

bon apres midi
MichelXld

 

[speedball]

C'est carement mieux, l'image n'est plus compacter.

Mais l'image se fait sur toute les lignes non masquées (A1:M63)

J'ai l'impression que tu selectionne les lignes...
:huh:

Peut on corriger ce probleme en selection une zone (A1: K63)

A+

 

[MichelXld]

remplaces la ligne

Sheets('Saison').UsedRange.CopyPicture

par

Sheets('Saison').Range('A1:K63').CopyPicture


MichelXld

 

[speedball]

Excellent

Mais je voudrais pousser un peu plus loin, en exportant toute les feuilles du classeur par le nom inscrit dans l'onglet.

Peut tu me montrer l'adaptation pour une autre feuille (Equipe) de (A1:M24).

Je me chargerais des autres.

Merci
A+

 

[speedball]

Je vais peut etre revenir sur ce que je t'ai dit.

Car je vois la taille de mon fichier augmenter de facon importante 400Ko à 1300Ko.

Et je l'ai testé sur un autre poste mais l'image est coupée????

A+