Insertion automatique d'une image à partir de son nom

Renaud22

XLDnaute Junior
Bonjour à tous,

J'ai un fichier (Exemple.xlsm) qui contient 6 espaces réservés à des images. En cliquant une seule fois sur un des rectangles, le répertoire contenant les images s'ouvre. Je peux alors sélectionner l'image désirée et celle-ci est collée à l'endroit désigné, dimensionnée selon les critères définis dans le code VBA (' Macro & instructions pour coller une photo et le nom de celle-ci (B11)....) et le nom du fichier est indiqué en haut à gauche de l'image. Les images sont de format JPG et leur préfixe commence par 001, 002, 003,....999, 1000.

Mon problème est le suivant : j'aimerais pouvoir également copier les images automatiquement en conservant les dimensions prédéfinis en tapant le nom de l'image. Par exemple : cadre B11 @ E17, je tape en "B10", le numéro : 032 suivi de "Entrée" et automatiquement la photo 032.jpg sera collée dans le cadre B11 @ E17 et ainsi de suite pour les 5 autres espaces réservés aux images. Afin d'éviter l'ouverture du répertoire contenant les images après l'appui sur la touche "Entrée", il faudra modifier le code VBA (' Macro & instructions pour coller une photo et le nom de celle-ci (B11)....) pour activer un rectangle avec un double-clic au lieu d'un simple clic (cas actuel).

Si vous avez des questions, n'hésitez à me contacter.

En vous remerciant par avance pour votre précieuse aide.

Salutations,

Renaud D.
 

Fichiers joints

Lone-wolf

XLDnaute Barbatruc
Bonjour Renaud :), le Forum :)

Je ne comprends pas pourquoi tu veux avoir 3 méthodes d'insertion image?? :rolleyes:. D'après ce que tu dit, il y a

Private Sub Worksheet_SelectionChange - Private Sub Worksheet_Change(en tapant le nom de l'image) et Private Sub Worksheet_BeforeDoubleClick.

Pour mieux faire, au lieu d'avoir des cellules fusionnées, prend seulement une cellule. En PJ, une classeur exemple pour redimensionner une image à la grandeur d'une cellule. Dans la feuille1, clique sur le bouton, et en feuille 2, modifie la grandeur de la cellule A1 pour voir le résultat.
 

Fichiers joints

Dernière édition:

Renaud22

XLDnaute Junior
Bonjour Lone-wolf,

Merci d'avoir répondu à ma requête. Le fichier "Exemple.xlsm" est une version très simplifiée du fichier avec lequel je travaille habituellement. Les autres macros contenues dans ce fichier servent à d'autres opérations. Pour les besoins de la cause, j'ai réduit fortement sa capacité en ko. Pour des raisons pratiques, je veux disposer de plusieurs formes d'insertion d'image soit directement en cliquant sur un groupe de cellules me permettant d'ouvrir un répertoire afin de sélectionner l'image désirée mais aussi en tapant le numéro de l'image afin de coller celle-ci dans l'espace lui étant réservé. Est-il possible pour vous de m'aider afin d'atteindre ces objectifs à partir du fichier "Exemple.xlsm" transmis.

Au plaisir de vous lire,

Salutations,

Renaud D.
 

job75

XLDnaute Barbatruc
Bonjour Renaud22, Lone-wolf,
je tape en "B10", le numéro : 032 suivi de "Entrée" et automatiquement la photo 032.jpg sera collée dans le cadre B11 @ E17
Pour que le zéro ne disparaisse pas il faut que B10 G10 B18 G18 B26 E26 soient au format Texte.

La macro :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, chemin$, s As Shape, fich$
Set r = [B11,G11,B19,G19,B27,E27] 'plage à adapter
chemin = ThisWorkbook.Path & "\" 'chemin des photos, à adapter
Application.ScreenUpdating = False
For Each s In Shapes
  If Not Intersect(s.TopLeftCell, r) Is Nothing Then s.Delete 'RAZ
Next
For Each r In r
  fich = chemin & r(0, 1) & ".jpg"
  If Dir(fich) <> "" Then
    With Pictures.Insert(fich)
      .Top = r.Top
      .Left = r.Left
      .ShapeRange.LockAspectRatio = msoFalse
      .Height = r.MergeArea.Height
      .Width = r.MergeArea.Width
    End With
  End If
Next
End Sub
A+
 

Renaud22

XLDnaute Junior
Bonjour job75,

Serait-il possible pour vous d'intégrer votre macro au fichier "Exemple.xlsm" joint précédemment afin que je puisse tester le fonctionnement de celle-ci et vérifier si les deux modes d'insertion d'image sont opérationnels (insertion d'image directement ou par le nom)?

Salutations,

Renaud22
 

job75

XLDnaute Barbatruc
Re,

Je ne toucherai certainement pas aux codes existants dignes d'un stakhanoviste.

Pour tester virez la macro Worksheet_Change actuelle et remplacez-la par la mienne.

A+
 

Discussions similaires


Haut Bas