Bonjour,

Voici un petit moment que je galère sur ma macro "savesheet", qui consiste à (au moment du click sur le bouton) :
A - créer un dossier portant le nom de la cellule O19 - fonctionne
B - exporter la copie Excel de ce fichier, reprenant le nom de la cellule O20 dans le dossier créer en A - fonctionne
C - exporter la feuille en PDF, reprenant aussi le nom de la cellule O20 , toujours dans ce même dossier - fonctionne
D - enregistrer une image issue d'une plage de cellule dans ce même dossier - fonctionne partiellement

Pourquoi "fonctionne partiellement" ? je m'explique
L'image que je crée, issue d'une plage de cellule s'enregistre bien, mais dans le répertoire ou se trouve mon fichier Excel parent.
Or je souhaite l'enregistrer dans le dossier créée en debut de macro, reprennant la valeur de la cellule 019.
019 et une cellule qui s'incrémente à chaque "Clear" du fichier (fonction avec bouton)

on Obtiens donc un dossier par enregistrement avec normalement 3 fichiers à l'intérieure :
- la copie excel
- le PDF
- l'image ou les images.

Sauf qu'a ce jour, je ne parviens pas a mettre l'image dans mon dossier.
un petit coup de main serait le bienvenue

le code
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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Const Repert As String = "W:\Quality Management\Soumissions"
Sub Save_sheet()
Dim SousRep$, sPath$
ActiveSheet.Unprotect
SousRep = Range("O19").Text
sPath = Repert & SousRep
'Teste si le repertoire existe sinon creation
If Len(Dir(sPath, vbDirectory)) = 0 Then
MkDir sPath
End If
'sauvegarde du fichier Excel
ActiveWorkbook.SaveCopyAs sPath & "" & Range("O20").Value & ".xls"
 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & "" & Range("O20").Value, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
End Sub
 
Sub KopImg()
Dim MyChart As Chart, NomImage As String
'Récupération du texte d'une cellule ou d'un nom prédéfini pour l'image
NomImage = Range("O21").Text
'Copie des cellules cible selon tableau. A adapter selon besoin
Range("F18:J30").CopyPicture Appearance:=xlScreen, Format:=xlPicture
'Copier l'image selon nom souhaité avec mensurations
ActiveSheet.Paste: Selection.Name = NomImage
Haut = ActiveSheet.Shapes(NomImage).Height
Large = ActiveSheet.Shapes(NomImage).Width
'Copie sur l'ordinateur à adapter. Ici sur dossier Bureau avec le nom de l'image
chemin = "W:\Quality Management\Soumissions" & "" & NomImage & ".jpg"
With ActiveSheet
 
Set MyChart = .ChartObjects.Add(0, 0, Large, Haut).Chart
    'Réalise l'export avec l'objet Chart puis supprime ce dernier
    With MyChart
        .Parent.Activate
        .ChartArea.Format.Line.Visible = msoFalse 'Ligne du cadre non visible
        .Paste
        .Export Filename:=chemin
        .Parent.Delete
    End With
End With
  Set MyChart = Nothing
  ActiveSheet.Shapes(NomImage).Delete
Range("B2").Select 'Ou tout autre cellule
 
End Sub