Code VBA pour userform

Bonjour, j'ai créé une macro me permettant de faire une copie d'une feuille excel et de l'enregistrer sur le dossier ou se trouve le fichier excel.

En revanche, je n'arrive pas à afficher l'image sur le même principe et ne pas mettre de chemin fixe car celui-ci évolue en fonction de l'endroit ou est enregistrer le fichier.

Merci de votre aide afin que je puisse le visualiser en lanceant la macro.

Bonne rentrée à tous

Sub CopieRangePicture_JPG()
Sheets("Photos").Select
Dim Gr As Object, Rg As Range, R$, N$, C$, PathFich$
R$ = "A1:E7"                 '< range de données
N$ = ActiveSheet.Range("A1")   '< cell. avec nom du fich(sans point ni extension)
O$ = Worksheets("Réponse").Range("J7")  '< cell. avec nom du fich(sans point ni extension)
P$ = Worksheets("Réponse").Range("J8")   '< cell. avec nom du fich(sans point ni extension)
C$ = ActiveWorkbook.Path & "\" '< chemin avec \
'                          .

' suite exécution ...
Application.ScreenUpdating = False
PathFich$ = C$ & N$ & O$ & P$ & ".jpg"
' copie du range en image
Set Rg = ActiveSheet.Range(R$): Rg.CopyPicture xlScreen, xlPicture: DoEvents
' crée un graph pour accueillir l'image
Set Gr = ActiveSheet.ChartObjects.Add(0, 0, Rg.Width, Rg.Height): DoEvents
' active graph/copie l'image range dedans
Gr.Activate: ActiveChart.Paste: DoEvents
' exporte l'image sur disque
Gr.Chart.Export PathFich, "jpg": DoEvents
' delete graph et libère mémoire
Gr.Delete: Set Gr = Nothing

End Sub
Sub AffImage()
N$ = ActiveSheet.Range("A1")   '< cell. avec nom du fich(sans point ni extension)
O$ = Worksheets("Réponse").Range("J7")  '< cell. avec nom du fich(sans point ni extension)
P$ = Worksheets("Réponse").Range("J8")   '< cell. avec nom du fich(sans point ni extension)
C$ = ActiveWorkbook.Path & "\" '< chemin avec \
PathFich$ = C$ & N$ & O$ & P$ & ".jpg"

End Sub

Bonjour,

Quel est le problème ? Vous envoyez un code sans préciser ce qui ne vous convient pas dedans. Et n'ayant pas joint votre fichier il est impossible à tester...

Donnez au moins les lignes qui bloquent... (et au mieux joignez le fichier).

De plus deux questions me viennent :

1. Essayez-vous d'enregistrer directement l'image en question sur le PC, sans fichier Excel ? Vous ne l'avez pas précisé.

2. Pourquoi coller l'image dans un graph ?

Enfin, les "$" servent seulement dans la déclaration des variables.

Ecrire Dim var$ est équivalent à Dim var as String

Donc dans la suite du code retirez les $, ca m'étonne d'ailleurs que vous n'ayez pas d'erreurs.

la sub copie range. picture fonctionne parfaitement. Elle a pour but de créer une image de la sélection A1;E7 de l'onglet "photos" et de l'enregistrer dans le dossier ou se trouve le document excel sous format JPeg et en se nommant selon des valeurs de cellule.

Je souhaite que la sub Affimage me permette de visualiser sur un bouton de commande la photo enregistrée en allant chercher l'image précédemment enregistré sur la sub précédente et celà de façon indépendante.

Le souci est que je n'arrive pas à coder pour que la sub aille dans le chemin du activeworkbooth.

Merci, c'est beaucoup plus clair.

Vous pouvez essayer avec la méthode FollowHyperLink :

ActiveWorkbook.FollowHyperlink Address:=PathFich

a ajouter en derniere ligne du sub

C'est ça !!!!!!!! Grand grand merci

Parfait. N'oubliez pas de marquer le fil en résolu. Bonne journée.

Re, je viens de me rendre compte que la photo reste. Saurais tu comment l'effacer sur le même principe ? J'ai essayé kill mais je n'y arrive pas

Si la commande "Kill PathFich" ne marche pas c'est que (très probablement) le fichier est ouvert par une autre application. Vous devez fermer la fenetre de visualisation avant de Kill. On parle bien entendu du fichier "image.jpg", vous ne devez pas utiliser Kill si vous souhaitez supprimer l'image DANS le classeur.

J'ai mis ça mais ca me met en débogage

Sub EffImage()
N$ = ActiveSheet.Range("A1")   '< cell. avec nom du fich(sans point ni extension)
O$ = Worksheets("Réponse").Range("J7")  '< cell. avec nom du fich(sans point ni extension)
P$ = Worksheets("Réponse").Range("J8")   '< cell. avec nom du fich(sans point ni extension)
C$ = ActiveWorkbook.Path & "\" '< chemin avec \
PathFich$ = C$ & N$ & O$ & P$ & ".jpg"
Kill PathFich
End Sub