Discussion :

[skyzix]

Bonjour

je souhaite coller une image dans une cellules et que cette image soit automatiquement a la taille de la cellule.
sachant que l'image se trouve dans le presse papier (copier / coller)

Merci pour votre aide

[Jean-Philippe André]

Salut,

en utilisant le macro recorder on trouve des choses. Mais en cherchant dans la aussi :
http://excel.developpez.com/faq/?pag...ImageClipBoard

Pour la copie dans le presse papier, qu'as-tu utilisé jusqu'à présent ?

UNe fois le collage fait, en passant par les informations Top/Left/Width/Height de la cellule, tu devrais retomber sur tes pattes

[keygen08]

Bonjour

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro1()
    Dim Photo As Variant
    Dim Gauche, Sommet, Largeur, Hauteur As Single
 
    Photo = Application.GetOpenFilename("Images JPEG (*.jpg), *.jpg")
    Gauche = Range("C2").Left
    Sommet = Range("C2").Top
    Largeur = Range("C2").Width
    Hauteur = Range("C2").Height
 
    If Photo <> False Then
        Feuil1.Shapes.AddPicture Photo, True, True, Gauche, Sommet, Largeur, Hauteur
    End If
End Sub

[skyzix]

Pour le moment j'en suis là
Mais je ne pige pas bien pour récupérer l'image dans le presse papier
dans le code ci-dessous je vais chercher l'image dans un dossier

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
Sub InsertionImage()
    Dim Emplacement As Range
    Dim Img As Object
    Dim ShapeObj As Shape
 
    'Boucle pour supprimer l'ancienne image
    For Each ShapeObj In ActiveSheet.Shapes
        If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete
    Next ShapeObj
 
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        'Définit l'emplacement de l'image
        Set Emplacement = Range("D3:E8")
 
        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
        With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
            .Name = "Cible"
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With
 
    Else
        MsgBox "Insertion d'image interrompue."
    End If
 
End Sub

Bonjour

Après avoir fouiné un peu partout

j'ai trouvé cela pour récupérer l'image dans le presse papier

Code :

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

1
2
3
4
5
If My.Computer.Clipboard.ContainsImage() Then
  Dim grabpicture As System.Drawing.Image
  grabpicture = My.Computer.Clipboard.GetImage()
  picturebox1.Image = grabpicture
End If

Pouvez-vous d'aider a fusionner les deux bout de code
merci

[skyzix]

Bon finalement en bidouillant dans tout les sens j'ai fini par trouvé
Je ne sais si c'est top niveau code mais ca fonctionne

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
Sub InsertionImage()
    Dim Emplacement As Range
    Dim Img As Object
    Dim ShapeObj As Shape
 
    'Boucle pour supprimer l'ancienne image
    For Each ShapeObj In ActiveSheet.Shapes
        If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete
    Next ShapeObj
 
    If Application.ActiveSheet.Paste Then
        'Définit l'emplacement de l'image
        Set Emplacement = Range("D3:E8")
 
        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
        With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
            .Name = "Cible"
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With
 
    Else
        MsgBox "Insertion d'image interrompue."
    End If
 
End Sub

[skyzix]

Bonjour

Au boulot ils ont changé tous nos PC et maintenant nous avons Excel 2010
depuis que nous avons cette version mon code ne fonctionne plus

C'est a dire qu'il récupère le fichier PDF, le colle a emplacement prévu puis il affiche la Msgbox
Il ne renomme pas le fichier en "cible2" ni redimensionne l'objet.

je ne trouve pas le problème
merci de votre aide

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
 
Sub InsertionPDF2()
    Dim Emplacement As Range
    Dim PDF As Object
    Dim ShapeObj As Shape
    Chemin = "\\Dellserver\Share2\LABO\Base de travail\Fichiers temporaires\temp XG\"
    texte = "Art49566_OF" & Range("h5") & ".002"
    'Boucle pour supprimer l'ancien pdf
    For Each ShapeObj In ActiveSheet.Shapes
        If ShapeObj.Name = "Cible2" Then ActiveSheet.Shapes("Cible2").Delete
    Next ShapeObj
 
    If ActiveSheet.OLEObjects.Add(Filename:=Chemin & texte & ".pdf", Link _
        :=False, DisplayAsIcon:=False).Select Then
        'Définit l'emplacement du pdf
        Set Emplacement = Range("A77:H99")
 
        Set PDF = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
 
        With PDF.ShapeRange
            'Nommer le PDF insérée (Pour la supprimer plus facilement ensuite)
            .Name = "Cible2"
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With
 
    Else
        MsgBox "Insertion d'image interrompue."
    End If
 
End Sub