Discussion :

[casefayere]

Bonjour à tou(te)s,

Cette nuit, j'ai concrétiser un code pour mes besoins propres, comme je l'ai enregistré en XLAM (excel 2007), je l'édite pour savoir si des améliorations peuvent être apportées,

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
Sub CAPTURE_FEUILLE()
Dim mes As Range, monImage As String, Sh As Shape, m As String
m = InputBox("NOM DE L'IMAGE", "DEFINIR UN NOM")
If m = "" Then: Exit Sub 'si l'operation est annulée
Set mes = Application.InputBox("Choix de cellule(s)", Type:=8)
 
    monImage = mes.Address
    Range(monImage).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    Sheets("Feuil1").Select
    ActiveSheet.Paste
  'Récupère la dernière forme de la feuille
    Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    'Définit le nom et le lieu de stockage de l'image
 
    monImage = "C:\Users\Dominique\Pictures\" & m & ".jpg"
 
    'Colle l'image dans un graphique
    With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
        .Paste
        'Sauvegarde l'image du graphique au format jpg
        .Export monImage, "JPG"
    End With
 
    'Supprime le graphique et la forme.
    With ActiveSheet
        .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
        .Shapes(ActiveSheet.Shapes.Count).Delete
    End With
 
End Sub

Merci d'avance

[Qwazerty]

Salut
Voila quelques modifs

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
Sub CAPTURE_FEUILLE()
Dim mes As Range, monImage As String, Sh As Shape, m As String
m = InputBox("NOM DE L'IMAGE", "DEFINIR UN NOM")
If m = "" Then: Exit Sub 'si l'operation est annulée
Set mes = Application.InputBox("Choix de cellule(s)", Type:=8)
 
    'monImage = mes.Address
    'Range(monImage).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    mes.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    'Sheets("Feuil1").Select
    'ActiveSheet.Paste
    With Sheets("Feuil1")
        'Sheets("Feuil1").Paste
        .Paste
        'Récupère la dernière forme de la feuille
        'Set Sh = ActiveSheet..Shapes(ActiveSheet..Shapes.Count)
        Set Sh = .Shapes(.Shapes.Count)
        'Définit le nom et le lieu de stockage de l'image
        monImage = "C:\Users\Dominique\Pictures\" & m & ".jpg"
 
        'Colle l'image dans un graphique
        With .ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
            '.Paste
            .Chart.Paste ' pour eviter les probleme lié a l'imbrication de with, normalement ca n'est pas utili mais bon paste etant valable pour chart comme opur sheets("feuil1")
            'Sauvegarde l'image du graphique au format jpg
            '.Export monImage, "JPG"
            .Chart.Export monImage, "JPG"
        End With
 
        'Supprime le graphique et la forme.
        '.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
        '.Shapes(ActiveSheet.Shapes.Count).Delete
        .ChartObjects(.ChartObjects.Count).Delete
        .Shapes(.Shapes.Count).Delete
 
    End With
 
End Sub

A++
Qwaz

[casefayere]

Je viens de regarder, me suis rendu compte que tu l'avais bien allégé.

Quant à la ligne :

Code :

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

If Error = "424" Then Exit Sub

je croyais déjà l'avoir supprimée, c'est vrai qu'elle ne servait à rien

Merci encore

[Qwazerty]

Salut
Je n'ai et ne vois toujours pas pas cette ligne dans ton code , toi tu es fatigué ^^.
a++
Qwaz

[casefayere]

C'est parce que j'ai comparé avec la macro que j'avais gardé mais je n'ai pas du enregistré quand j'ai enlevé cette ligne,

J'aurai pas du le dire, ça faisait une bétise de moins

Mais là, j'ai fait attention à tout, remplacé par ton code et bien enregistré mon xlam.

Merci encore