accéder aux images depuis une cellule dans excel 2010 Résolu

Question

Bonjour, 

Je suis en train de faire un tableau pour un professionnel. Celui ci doit être "esthétique" et surtout très simple!
Je souhaite que dans la cellule B5, par exemple, lorsqu'il clique, il accède au menu windows pour pouvoir y ajouter une photo. Celle ci aura une taille fixe et sera attachée à la cellule.
Je ne connais pas le VBA :(

J'ai déjà fais une recherche sur le forum mais rien ne correspond exactement.

Je peux vous envoyer mon fichier. Ne vous moquez pas de mes méthodes qui ne sont certainement pas les plus efficaces!

Je vous remercie par avance pour votre aide.


Configuration: Windows 7 / Mozilla 11.0

gbinforme · Answer

Bonjour, 
 
 il accède au menu windows pour pouvoir y ajouter une photo

C'est quoi ce menu que tu veux ?

cs_Le Pivert · Answer

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

cs_Le Pivert · Answer

voici un autre exemple:

http://www.cjoint.com/c/EHrjFMIvk4Q

cs_Le Pivert · Answer

Voir ceci:


 https://forum.excel-pratique.com/viewtopic.php?forum_uri=cours-astuces&t=1314&start=

Mettre ceci dans la feuille1


Option Explicit
Dim chemin, Var As Variant
Dim position, largeur, hauteur, ratio, Ligne, Colonne
Dim img As Object
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B11:B12")) Is Nothing Then
position = Target.Address
Ligne = Target.Row
Colonne = Target.Column
position = Replace(position, "$", "")
ImportImages
End If
End Sub
Sub ImportImages()
   Dim oPict As New stdole.StdPicture
  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
Sub efface()
    For Each img In Worksheets(1).Shapes 'ou Worksheets("nom").Shapes
     img.Delete
    Next
End Sub
Sub BoucleHauteur()
 Dim Ligne As Range
 For Each Ligne In ActiveSheet.UsedRange.Rows
 Ligne.RowHeight = 15
 Next
 End Sub
 Sub BoucleLargeur()
 Dim Colonne As Range
 For Each Colonne In Range("A1:Z2000").Columns
 Colonne.ColumnWidth = 10.71
 Next
 End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
efface
BoucleHauteur
BoucleLargeur
End Sub

cs_Le Pivert · Answer

Ne jamais rien mettre au dessus de Option Explicit!

voici le code:


Option Explicit
Dim chemin, Var As Variant
Dim position, largeur, hauteur, ratio, Ligne, Colonne
Dim img As Object
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B12:B13")) Is Nothing Then
position = Target.Address
Ligne = Target.Row
Colonne = Target.Column
position = Replace(position, "$", "")
ImportImages
End If
End Sub
Sub ImportImages()
   Dim oPict As New stdole.StdPicture
  chemin = Application.GetOpenFilename
  If chemin = False Then Exit Sub 'annulation
  hauteur = 40 'a adapter la hauteur de l'image à la cellule
 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
Sub efface()
    For Each img In Worksheets(1).Shapes 'ou Worksheets("nom").Shapes
     img.Delete
    Next
End Sub
Sub BoucleHauteur()
 Dim Ligne As Range
 For Each Ligne In ActiveSheet.UsedRange.Rows
 Ligne.RowHeight = 15
 Next
 End Sub
 Sub BoucleLargeur()
 Dim Colonne As Range
 For Each Colonne In Range("A1:Z2000").Columns
 Colonne.ColumnWidth = 10.71
 Next
 End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
efface
'BoucleHauteur
'BoucleLargeur
End Sub
Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

End Sub

Private Sub DTPicker3_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

End Sub

Private Sub DTPicker4_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

End Sub

Private Sub DTPicker6_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

End Sub

cs_Le Pivert · Answer

1_

.Left = Range(position).Left + 100 distance du bord gauche de la cellule

2_

chemin = Application.GetOpenFilename

3_


je n'ai pas compris

4_

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B2")) Is Nothing Then
Target.Value = Target.Value & " ans"
End If
End Sub

Accéder aux images depuis une cellule dans excel 2010

6 réponses

Discussions similaires

Newsletters