Inserer images cellule active.xlsx Résolu

Question

Bonjour
.
J'essaie d'intégrer une macro sur un fichier.xlsx qui permet d'insérer des photos dans les cellules actives.
.
J'ai plusieurs contraintes :
- Je voudrais que les images se dimensionnent à la hauteur de ligne.
- J'ai plusieurs photos qui seront dans le même dossier ou se trouve ce fichier. Je veux donc choisir les images sans avoir a toucher les images (modifier nom, les positionner dans un répertoire particulier...)
.
J'ai déjà çà comme base mais ca ne me convient pas et j'utilise CTRL + SHIFT + I :
.
-------------------------
Sub InsererImage()

    ActiveSheet.Pictures.Insert("C:\image.jpg").Select
             
    With Selection.ShapeRange
        .Left = ActiveCell.Left
        .Top = ActiveCell.Top
    End With
    
End Sub
----------------------------------
.
Merci pour votre aide.
Sam77181
.

Configuration: Windows / Firefox 40.0

cs_Le Pivert · Answer

Bonjour,

Voici un exemple:

http://www.cjoint.com/c/EIwmXn5Pw8Q

Sam77181 · Answer

Merci Pivert
.
C'est super ce fichier.
.
Je pense pouvoir exploiter ce que tu m'as envoyé, mais je suis embêté en partie car je souhaite pouvoir choisir moi même les images dans le répertoire "Dossierimages" pour les mettre dans l'ordre qui me convient un à un si nécessaire.
.
cela faisait longtemps que je n'utilisais plus excel pour ce genre de besoin, et je suis toujours aussi étonné de voir ce que l'on peut faire avec.

Merci
Sam

cs_Le Pivert · Answer

Voilà:

 http://www.cjoint.com/c/EIwnzGvCpWQ

cs_Le Pivert · Answer

Pour l'ouverture sur le dossier:

Sub ImportImages()
   Dim oPict As New stdole.StdPicture
    ChDir "C:\Users\....\Pictures" 'adapter chemin dossier à ouvrir
  chemin = Application.GetOpenFilename
  If chemin = False Then Exit Sub 'annulation
  hauteur = 100 'a adapter la hauteur de l'image
 Set oPict = stdole.LoadPicture(chemin)
 ratio = oPict.Width / oPict.Height
If oPict.Height < oPict.Width Then 'mode paysage
largeur = hauteur * ratio
Else
largeur = hauteur * ratio
End If
     Columns(Colonne).ColumnWidth = largeur / 5.5
     Rows(Ligne & ":" & Ligne).RowHeight = hauteur
  ActiveSheet.Pictures.Insert(chemin).Select
  Var = Selection.Name
  Selection.ShapeRange.LockAspectRatio = msoFalse
  With ActiveSheet.Shapes(Var)
    .Top = Range(position).Top
    .Left = Range(position).Left
    .Height = hauteur
    .Width = largeur
     End With
     End Sub 

Pour la plage de cellule:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("A1:F38")) Is Nothing Then 'a adapter la plage de cellule
position = Target.Address
Ligne = Target.Row
Colonne = Target.Column
position = Replace(position, "$", "")
ImportImages
End If
End Sub

cs_Le Pivert · Answer

Je vois cela cette après-midi

cs_Le Pivert · Answer

Voila, il faudra activer le chemin du dossier à ouvrir, après l'avoir adapter:

http://www.cjoint.com/c/EIxlvG8LLvQ

cs_Le Pivert · Answer

Le dernier classeur était en Excel 2007, celui-ci est en 2003:

 http://www.cjoint.com/c/EIxl5z0xSYQ

Inserer images cellule active.xlsx

7 réponses

Newsletters