(Résolu) Insérer plusieurs images en même temps en VBA et intégrées aux cellules

[crhm]

Bonjour à tous ,

Un grand merci pour tout le travail réalisé sur ce forum de la part de tous les utilisateurs. Je viens vers vous concernant une VBA pour insérer "plusieurs" images "en même temps" dans une cellule dimensionnée. J'ai parcouru bon nombre de forums sur des sujets similaires mais jamais sur ce cas précis. J'ai donc effectué bon de recherches avant de faire cette demande ici.

J'ai déjà une formule qui marche très bien pour insérer une "seule" image. Je lance une VBA qui lance l'explorateur et je peux aller chercher ma photo. En validant, la photo prend la dimension de la cellule sélectionnée et fait "partie intégrante" de la cellule (c'est à dire qu'en effectuant des filtres, les photos disparaissent ou apparaissent comme du texte).

Je voulais savoir si il est possible de faire la même chose mais en insérant "plusieurs" photos en "même temps". Je vous donne ma première formule (qui fonctionne avec un zoom à 100% uniquement ). Pour le moment, impossible de sélectionner plusieurs photos dans l'explorateur, même en faisant la touche CTL.

Vous trouverez mon fichier test en copie et la formule ci-dessous.

Un grand merci pour vos conseils .


Public Sub insere_image()
Dim ficimg As Variant
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = ActiveCell.Top ' haut de la cellule
.Left = ActiveCell.Left ' gauche de la cellule
.Height = ActiveCell.RowHeight ' hauteur de la cellule
.Width = ActiveCell.Width ' largeur de la cellule
End With
With Selection
.PrintObject = True ' l'objet est imprimé en même temps que le document
.Placement = xlMoveAndSize ' manière dont l'objet est lié aux cellules
End With
End Sub

 

[Robert]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Bonjour CHRM, bonjour le forum,

Pour insérer plusieurs images tu peux essayer comme ça :

Application.Dialogs(xlDialogInsertPicture).Show

Mais après je sais pas comment tu vas faire...

 

[Papou-net]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Bonjour crhm, Robert, le Forum,

Pour sélectionner plusieurs fichiers dans la boîte de dialogue, il faut régler la propriété Multiselect à True (elle est sur False par défaut).
L'appel à cette boîte se fait donc de la manière suivante :

ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image", , True) ' choix nom du fichier

Quant au reste de la macro, il faut la modifier comme ceci :

Public Sub insere_image()
Dim ficimg, nbImg As Byte

On Error Resume Next
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image", , True) ' choix nom du fichier
For Each cel In Selection
  cel.Activate
  nbImg = nbImg + 1
  If Not ficimg(nbImg) = "" Then
    ActiveSheet.Pictures.Insert(ficimg(nbImg)).Select  ' insertion
    With Selection.ShapeRange
      .LockAspectRatio = False        ' proportions d'origine lorsque vous la redimensionnez
      .Top = ActiveCell.Top           ' haut de la cellule
      .Left = ActiveCell.Left         ' gauche de la cellule
      .Height = ActiveCell.RowHeight  ' hauteur de la cellule
      .Width = ActiveCell.Width ' largeur de la cellule
    End With
  End If
Next
End Sub

Elle fonctionne ainsi :

Elle balaie et active chaque cellule de la sélection et incrémente la variable nbImg (nombre d'images) de 1 à chaque passage. Cette variable sert à lire la ligne correspondante dans la variable tableau stockée dans ficimg. C'est VBA qui initialise cette variable en tableau par défaut. Ensuite, il ne reste plus qu'à appliquer les propriétés désirées à chaque image, au sein de cette boucle.

Je joins le fichier qui va bien.

Espérant avoir résolu.

Cordialement.

 

[Robert]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Bonjour le fil, bonjour le forum,

Papou-net chapeau bas. Je n'avais pas compris cela. Je pensais qu'il fallait faire rentrer toutes les images dans une seule cellule et les redimensionner en fonction... Aussi je ne m'y suis même pas aventuré...

Mais j'ai testé ton fichier et j'y ai rencontré un problème. Quand tu sélectionnes par exemple 3 cellules J3, J4 et J5. Puis tu sélectionnes donc 3 images...
La première s'adapte bien à J3. Ensuite la seconde va bien jusqu'au pasage de :

.Width = ActiveCell.Width ' largeur de la cellule

Là ce n'est pas la seconde mais les deux images qui se redimensionnent et donc la première dépasse ou bien est retrécie en fonction de la taille de la seconde.
Idem pour la troisième... Finalement seule la dernière est correctement dimensionnée, les autres seront à chaque nouvelle image redimensionnées et au final on a pas le résultat escompté. Si tu as fait des tests avec des images de taille identique tu n'as pas vu, je pense, ce problème...

 

[Papou-net]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Mais j'ai testé ton fichier et j'y ai rencontré un problème. Quand tu sélectionnes par exemple 3 cellules J3, J4 et J5. Puis tu sélectionnes donc 3 images...
La première s'adapte bien à J3. Ensuite la seconde va bien jusqu'au pasage de :

.Width = ActiveCell.Width ' largeur de la cellule

Là ce n'est pas la seconde mais les deux images qui se redimensionnent et donc la première dépasse ou bien est retrécie en fonction de la taille de la seconde.
Idem pour la troisième... Finalement seule la dernière est correctement dimensionnée, les autres seront à chaque nouvelle image redimensionnées et au final on a pas le résultat escompté. Si tu as fait des tests avec des images de taille identique tu n'as pas vu, je pense, ce problème...

Bonjour Robert,

Apparemment, ce que tu décris se produit bien sous Excel 2003, mais fonctionne parfaitement sous 2010, version sous laquelle je travaille.

Laissons crhm nous confirmer, puisqu'il est aussi sous 2010.

En te souhaitant une bonne journée.

Cordialement.

 

[crhm]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Bonjour Papou-net et Robert,

Un grand merci pour vos recherches et vos compléments sur cette formule. Effectivement, je n'arrive pas au résultat escompté... je me suis peut être mal exprimé.

Je vous laisse en copie un nouveau fichier test contenant les photos (numérotées 0001, 0007, 0053 et 0103), le tableau excel sans photos et le tableau excel avec photos insérées (avec la formule que j'avais et que vous avez découvert dans mon premier message).

Ici j'ai fait la manipulation avec seulement 4 photos et en insérant les photos une par une. Ça marche super mais j'ai des tableaux avec des centaines de photos. Dans ce cas, ce qui est super, c'est qu'en effectuant un filtre, les photos se cachent....

J'espère que ce nouveau document en copie vous aidera (si vous en avez le temps bien sûr...).

Merci !

 

[Papou-net]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

RE

@ Robert :

Au temps pour moi, je n'ai pas joint la bonne version du fichier. Mais par contre, la macro telle que citée dans mon message, fonctionne aussi bien sous 2003 que sous 2010.

@crhm :

J'ai ouvert ton fichier avec les photos, mais elles n'y figurent pas car la liaison ne se fait pas à l'ouverture sur mon poste. Normal, puisque nous n'avons pas les mêmes arborescences. Par contre, peux-tu essayer avec le fichier modifié ci-joint, car je me suis trompé lors de mon dernier envoi ?

Dans cette attente.

Cordialement.

 

[crhm]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Papou-net,

J'ai donc essayer le nouveau tableau que tu as envoyé et effectivement, ça marche super . Je peux sélectionner une, deux ou trois des 4 photos et les coller dans les cellules sélectionnées. Ok pour le redimensionnement et la sélection !

Par contre, il reste un dernier petit souci...

La photo ne semble pas "intégrée" dans la cellule comme elle le fut dans ma première formule de base. C'est à dire que quand je "filtre", les photos ne disparaissent pas et restent à l'endroit où elles ont été insérées.

Pourrais-tu faire le test avec les photos que je t'ai envoyé et ma formule pour vraiment que tu puisses voir ce que je veux dire ?

En tout cas, un grand merci car c'est déjà super bien comme ça !!!

(je remets en copie le tableau sans photos insérées et les 4 photos au cas tu ne les aurais plus).

 

[crhm]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Je viens de m'apercevoir d'un souci... quand j'insère plusieurs photos, elle s'insèrent à l'envers...

Par exemple : en sélectionnant la 001 et 0103, c'est la 0103 puis en dessous la 001 qui s'insèrent...

Y'a t'il un ajustement de possible pour ça ?

 

[Papou-net]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Par contre, il reste un dernier petit souci...

La photo ne semble pas "intégrée" dans la cellule comme elle le fut dans ma première formule de base. C'est à dire que quand je "filtre", les photos ne disparaissent pas et restent à l'endroit où elles ont été insérées.

En fait, ce sont les propriétés par défaut des images qui sont en cause. Il faut donc modifier la propriété "Placement" dans le code, soit :

Public Sub insere_image()
Dim ficimg, nbImg As Byte
Dim Cel As Range, Plage As Range

On Error Resume Next
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image", , True) ' choix nom du fichier
Set Plage = Selection
For Each Cel In Plage
  Cel.Select
  Selection.ShapeRange.Delete
  nbImg = nbImg + 1
  If Not ficimg(nbImg) = "" Then
    ActiveSheet.Pictures.Insert(ficimg(nbImg)).Select  ' insertion
    With Selection.ShapeRange
      .LockAspectRatio = False        ' proportions d'origine lorsque vous la redimensionnez
      .Top = ActiveCell.Top           ' haut de la cellule
      .Left = ActiveCell.Left         ' gauche de la cellule
      .Height = ActiveCell.RowHeight  ' hauteur de la cellule
      .Width = ActiveCell.Width       ' largeur de la cellule
    End With
    Selection.Placement = xlMoveAndSize
  End If
Next
End Sub

Je viens de m'apercevoir d'un souci... quand j'insère plusieurs photos, elle s'insèrent à l'envers...
Par exemple : en sélectionnant la 001 et 0103, c'est la 0103 puis en dessous la 001 qui s'insèrent...
Y'a t'il un ajustement de possible pour ça ?

Sur ce point, on ne maîtrise rien, c'est la fonction GetOpenFileName qui gère. La seule solution qui me paraît possible, c'est de lancer cette boîte de dialogue pour chaque image, au sein de la boucle de lecture des cellules sélectionnées. Mais on perd l'avantage d'une action groupée, n'est-ce pas ?

Cordialement.

 

[Papou-net]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

RE:

Voici une solution pour insérer des images dans un ordre quelconque, mais tu constateras que c'est nettement moins performant.

Cordialement.

 

[crhm]

Re : Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Bonjour Papou-net,

J'ai essayé tes nouveaux tableaux et le "Copie 01..." marche à merveille, à une condition.

Les photos s'insèrent dans l'ordre tant que les cellules sélectionnées accueillant les photos soient "contiguës". Le second tableau est super également par rapport au début des recherches mais moins performant du coup, effectivement.

Je ne sais pas comment te remercier pour ton précieux travail qui va me faire gagner un temps inimaginable...
J'espère que cette formule pourra servir à d'autres !!!

Encore un grand merci à toi et Robert !

Bien à vous.

 

[Papou-net]

Re : (Résolu) Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Bonjour crhm,

A mon tour de te remercier pour ta politesse et ton respect de la charte.

Pour en revenir au sujet, rien ne t'empêche de conserver ces deux macros dans ton programme, en leur donnant un nom différent bien entendu. Ainsi, tu pourrais gagner du temps pour les insertions contiguës et de l'efficacité dans les autres cas.

Bonne journée.

Cordialement.

Amicales salutations à Robert également.

 

[romainl88]

Re : (Résolu) Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Bonjour,

Je me permet de revenir sur ce sujet car j'ai une macro qui fonctionnait bien sous excel 2007 et je suis passer en excel 2010 et depuis les images que j’insérai via un chemin ne s'affiche plus du moment ou je supprime ou je renomme, le dossier d'image en question. Pourriez vous regardez se qui cloche et me donner une solution merci.

Voici le code

Sub InsertionImages()

Dim Repertoire As String
Dim Extension As String
Dim Fichier As String


'Saisie du nom du répertoire
Repertoire = InputBox("Chemin complet du répertoire (\ à la fin)", "Répertoire", "D:\test\")
If Repertoire = "" Then Exit Sub

'Saisie du type d'extension
Extension = InputBox("Type de fichier (sans le point, ex : jpg, png, bmp)", "Type de fichier", "jpg")
If Extension = "" Then Exit Sub
'Récupération du premier fichier du répertoire
Fichier = Dir(Repertoire & "*" & Extension, vbDirectory)

L = -3
c = 4

Do While Fichier <> ""
i = i + 1
'Insertion de l'image
L = L + 5
'Verification 3 photos
If L = 17 Then
c = c + 13
L = 2



End If
ActiveSheet.Pictures.Insert(Repertoire & Fichier).Select

'Selection.Name = monimage & L
Selection.Name = Fichier
Selection.ShapeRange.LockAspectRatio = msoFalse
'With ActiveSheet.Shapes(monimage & L)
With ActiveSheet.Shapes(Fichier)

.Top = Cells(c, L).Top
.Left = Cells(c, L).Left
.Height = Range(Cells(c, L), Cells(c + 11, L)).Height

.Width = Range(Cells(c, L), Cells(c, L + 4)).Width

End With

Range("L18").Select

Fichier = Dir
Loop

End Sub

 

[Karim]

Re : (Résolu) Insérer plusieurs images en même temps en VBA et intégrées aux cellules

Bonjour Romainl88,
A tu eu une réponse à ta question??
J'ai le même souci que tu décris..

Merci de ta reponse stp