Insérer des photos rapidement Fermé

Question

Bonjour
Nouvelle arrivée j ai certaines idées pr me faciliter mon travail mais impossible de les mettre en place car le monde des VBA et macro est inconnu pr moi. Les tuto ne m aide pas vraiment.
Je travaille sur Excel 2016 et je voudrais insérer une dizaine de photos dans des cellules rapidement. Ces photos se trouvent dans un sous dossier dossier.
Arborescence:
Dossier nom prénom 
              > dossier admi > bilan (Excel)
              > dossier photos> bilan (jpeg)
Y a t il la possibilité de faire un lien rapide entre mon bilan Excel et les photos en jpeg 
Je sais pas si je suis bien claire...
Merci d avance
Comment pourrais je me former rapidement à cela pour réaliser des tâches quotidiennes?
Merciii

cs_Le Pivert · Answer

Bonjour,
Voici un exemple:
http://www.cjoint.com/c/FLFmNCOEhpQ
Voir ceci pour activer les macros
https://support.microsoft.com/en-us/office/enable-or-disable-macros-in-office-files-12b036fd-d140-4e74-b45e-16fed1a7e5c6?redirectsourcepath=%252ffr-fr%252farticle%252factiver-ou-d%2525c3%2525a9sactiver-les-macros-dans-les-documents-office-7b4fdd2e-174f-47e2-9611-9efe4f860b12&ui=en-us&rs=en-us&ad=us
@+ Le Pivert

cs_Le Pivert · Answer

Voici un autre exemple à adapter:
http://www.cjoint.com/c/GAbiOGQ0JkQ

cs_Le Pivert · Answer

Tu mets ce code dans toutes les feuilles concernées en les sélectionnant quand tu es dans l’Éditeur en haut à gauche :
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("A1:Z2000")) Is Nothing Then 'a adapter
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
    ChDir "C:\Users\Le Pïvert\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
Je n'ai pas mis le code de suppression par clic droit, a toi de voir?
@+ Le Pivert

cs_Le Pivert · Answer

Tu n'as pas besoin de changer de chemin, ce chemin t'ouvre une boite de dialogue qui te permet de choisir justement le chemin de ton fichier!
Pour le bug essaie cela:
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("A1:Z2000")) Is Nothing Then 'a adapter
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
    ChDir "C:\Users\Le Pivert\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
largeur = hauteur * ratio
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

cs_Le Pivert · Answer

Les 2 classeurs que j'ai mis fonctionnent très bien!
C'est au niveau de ton classeur qu'il y a un problème. Sans le voir, je ne peux pas faire grand chose.
Fais un essai sur un classeur vierge!

cs_Le Pivert · Answer

En mettant ton classeur sur ce site, sans données confidentielles. Pour que je vois si la macro dont tu parles est la cause du bug:
https://www.cjoint.com/

cs_Le Pivert · Answer

Voilà le classeur
Pour changer le chemin aller dans le Module3.
Voir les codes des feuilles 5 à 10
Double clic pour ouvrir une image
http://www.cjoint.com/c/GAirOvzSVcQ 
@+ Le Pivert

cs_Le Pivert · Answer

Si cela change ta mise en forme du tableau, tu peux jouer là dessus, tu diminues ou t'augmentes la hauteur
hauteur = 100 'a adapter la hauteur de l'image  
Pour le code des feuilles, quand tu es dans l’Éditeur, tu vois tes Modules au dessus il y a toutes les feuilles, il suffit de cliquer dessus pour voir le code!
PS je peux supprimer le classeur sur Ci-joint si tu veux, maintenant que cela fonctionne, tu me dis?

cs_Le Pivert · Answer

Si tu veux mettre la taille de ton image en fonction de la hauteur de ta cellule, il faut remplacer dans le module3 cette ligne:
hauteur = 100 'a adapter la hauteur de l'image 
par cette ligne;
 hauteur = ActiveCell.Height 
Voilà

cs_Le Pivert · Answer

Voilà le nouveau classeur. Les colonnes ne s'ajustent plus, elles restent fixes aux dimensions d'origine.
http://www.cjoint.com/c/GAjmXqBPflQ
Le classeur que tu as posté était enregistré en xlsx, ne prenant pas en charge les macros. Il faut enregistrer ton classeur en xlsm prenant en charge les macros!
@+ Le Pivert

cs_Le Pivert · Answer

Tu as 2 solutions:
1ère délimiter à une colonne ou plusieurs colonnes, l'ouverture de la macro comme ceci dans le code des feuilles:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("E:E")) Is Nothing Then 'a adapter
position = Target.Address
Ligne = Target.Row
Colonne = Target.Column
position = Replace(position, "$", "")
ImportImages
End If
End Sub

la macro ne se déclenchera que dans la colonne E
2ème un raccourci clavier que tu devras faire toi même en suivant les instructions de ce site:
http://www.info-3000.com/vbvba/raccourciclavier.php
Ensuite il faudra changer le code des feuilles et enlever 
ImportImages de la macro

cs_Le Pivert · Answer

J'ai fait le raccourci par code i comme image
Aller dans le module3  pour changer le chemin des images et la lettre du raccourci si nécessaire.
http://www.cjoint.com/c/GAkomsBz0fQ 
J'ai aussi changer le double clic par Worksheet_SelectionChange dans les feuilles concernées 5 à 10. Il suffira de sélectionner la cellule où insérer l'image
L'inconvénient c'est que dans toutes les feuilles quand la lettre i seule sera saisie l'ouverture du choix d'une image se fera.
@+ Le Pivert

cs_Le Pivert · Answer

Bonjour,
voila une nouvelle mouture avec un dossier image. Ne rien toucher au code, il s'ouvre directement sur le dossier image. Tu peux supprimer les images de ce dossier cela ne change rien à ton classeur.
Les images sont réglées pour ce mettre à la même hauteur que la cellule.
http://www.cjoint.com/c/GAwrgTSyw1Q 
@+ Le Pivert

cs_Le Pivert · Answer

et oui, une dernière chose, je ne peux pas supprimer les photos de mon dossier source par la suite, sinon elles disparaissent aussi du bilan... y a t il une alternative, car bcp de dossiers photos....
C'est toujours le même code, c'est simplement pour te faire voir qu'en supprimant une image du dossier, il n'y a aucune incidence sur ton classeur 

Parfois quand j'insert ma photo dans une cellule, même si cette dernière n'est pas petite, la photo apparaît en toute petite
et que les images sont à la dimension de la cellule

La deuxième, parfois quand je réajuste mes lignes, les photos se décalent toutes, ou quand je coupe des lignes avec des photos et que je les colle ailleurs sur la page, les photos ne suivent pas. 
Sur ce coup là, je ne peux pas t'aider
Bonne continuation

Insérer des photos rapidement

14 réponses

Discussions similaires