Discussion :

[JIPE59552]

Bonjour,
j'ai une plage de cellules de A1 à Y25 avec du texte et deux photos je voudrais exporter cette plage au format JPG et la renommer suivant la cellule A1 et si c'est possible en cellule E23 c'est inscrire le chemin ou ce trouve la photo
J'ai ce code mais je ne sais pas comment le modifier et en plus il créer un nouveau classeur
Merci

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
Sub CopiePlageDeCelluleEtExporterImage()
 
Application.ScreenUpdating = False
With Sheets("feuil1")
.Activate
Workbooks.Add
.Range("A1:Y25").CopyPicture
With ActiveSheet
.Paste
With .ChartObjects.Add(0, 0, _
Selection.Width, Selection.Height).Chart
.Paste
.ChartArea.Border.LineStyle = 0
End With
With .ChartObjects(1)
.Top = 0
.Left = 0
.Chart.Export "C:\Users\Jean-Paul. Masson\Pictures\photo mer.jpg", "jpg"
End With
End With
End With
 
End Sub

[Invité]

Bonjour,

Une solution possible :

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
Sub TestCreationImage()
 
Dim Sh As Worksheet
 
    Set Sh = Sheets("Feuil1")
    CopiePlageDeCelluleEtExporterImage Sh, Sh.Range("A1:Y25"), "photo mer.jpg", "C:\Users\Jean-Paul. Masson\Pictures\", Sh.Range("E33")
    Set Sh = Nothing
 
End Sub
 
Sub CopiePlageDeCelluleEtExporterImage(ByVal FeuilleImage As Worksheet, ByVal AireImage As Range, ByVal NomDeLImage As String, ByVal RepertoireImage As String, ByVal CelluleLien As Range)
 
Dim ShChObj As ChartObject
 
    With FeuilleImage
         AireImage.CopyPicture
         Set ShChObj = .ChartObjects.Add(0, 0, AireImage.Width, AireImage.Height)
         With ShChObj
                .Chart.Paste
                .Chart.Export RepertoireImage & NomDeLImage, "jpg"
                .Delete
         End With
         CelluleLien.ClearContents
         .Hyperlinks.Add Anchor:=CelluleLien, Address:=RepertoireImage & NomDeLImage, TextToDisplay:=NomDeLImage
         Set ShChObj = Nothing
    End With
 
End Sub

Le libellé du lien hypertexte est le nom de l'image et non le chemin. Si c'est le chemin qu'il faut, remplacer NomDeLImage par RepertoireImage dans TextToDisplay

Cordialement.

[JIPE59552]

Bonjour
j'ai une erreur de compilation sub ou function non définie

Le libellé du lien hypertexte est le nom de l'image et non le chemin. Si c'est le chemin qu'il faut, remplacer NomDeLImage par RepertoireImage dans TextToDisplay

moi c'est le nom du chemin en E23 comme ceci

Code :

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

.Hyperlinks.Add Anchor:=CelluleLien, Address:=RepertoireImage & NomDeLImage, TextToDisplay:=RepertoireImage

[Invité]

j'ai une erreur de compilation sub ou function non définie

Le code que j'ai mis en ligne fonctionne correctement chez moi.
Avez-vous vérifié la présence du \ à la fin du chemin dans "C:\Users\Jean-Paul. Masson\Pictures\" ?

Sinon, sans votre code on ne peut deviner.

moi c'est le nom du chemin en E23 comme ceci

Vous aurez compris que c'est vous qui définissez les paramètres dans la procédure TestCreationImage

Cordialement.

[JIPE59552]

Oui il y a le \ avec ou sans même problème et comme mes connaissance sont faible

[Invité]

Oui il y a le \ avec ou sans même problème

Quelle est l'extension du fichier Excel : .xls, .xlsx, .xlsm ?


Le fichier zip joint contient le fichier .xlsm avec son code. Si vous avez toujours un problème, modifiez le répertoire de destination et arrangez-vous pour qu'il ne contienne pas de "."

Pièce jointe 221642

Cordialement.