Discussion :

[casefayere]

Bonsoirà tou(te)s,

En parcourant le forum, je suis tombé sur un code qui m'intéresse (copie d'image excel) que j'ai adapté pour mes besoins, pas de problème,ça marche, voici le code, la question vient après :

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
Sub essai()
Dim mes, monImage As String, Sh As Shape
 
mes = InputBox("choisir la plage à inserer dans l'image", "CAPTURE D'IMAGE")
MsgBox mes
    Range(mes).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\copieexcel.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

l'inputbox me sert donc à choisir mes cellules. Peut'il rester actif et donner la main à la souris le temps de selection de la plage, il se remplirait en meme temps que la souris se déplace.

J'espère avoir été clair et bonne nuit à tou(te)s car j'imagine que ce n'est pas à cette heure que j'aurai une réponse

[casefayere]

J'ai déjà, en fouillant encore une partie de ma réponse mais une erreur est créer dans la suite :

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
Sub essai()
Dim mes As Range, monImage As String, Sh As Shape
 
Set mes = Application.InputBox("Choix de cellule(s)", Type:=8)
    Range(mes).CopyPicture Appearance:=xlScreen, Format:=xlBitmap 'erreur d'execution 1004 à ce niveau
    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\copieexcel.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

j'ai stipulé dans le code où l'erreur se situe, soit :

Code :

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

 Range(mes).CopyPicture Appearance:=xlScreen, Format:=xlBitmap 'erreur d'execution 1004 à ce niveau

Je pense que ça vient de ma variable mes, mais si quelqu'un peut m'en dire plus....
Merci d'avance

[casefayere]

Bon ben ça y est, plus la peine de chercher, je mets le code, ça peut servir

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
Sub essai()
Dim mes As Range, monImage As String, Sh As Shape, m As String
 
Set mes = Application.InputBox("Choix de cellule(s)", Type:=8)
    m = mes.Address
    Range(m).CopyPicture Appearance:=xlScreen, Format:=xlBitmap 'erreur d'execution 1004 à ce niveau
    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\copieexcel.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