J'ai Besoin d'aide !

[felippe_75]

Bjr à tous,

J'ai besoin de votre aide !

Comment insérer simultanément de nombreuses Photos et les faire s'ajuster à chaque cellule verticalement
dans la colonne A de mon classeur excel 2007?

Un de mes amis m'a prêté un fichier, contenant +1400 films vidéos.

J'aimerais pouvoir faire 2 choses, pour faciliter l'utilisation de cette banque de données!

1) Insérer simultanément (ou par groupes de plusieurs photos, format "JPEG")
la jaquette de chaque films et la placer dans la colonne A.

Sachant que les titres de chaque films, sont eux dans la colonne B.
Et tous sont classés par ordre A-Z. (titres des films et les photos/Jaquettes)

Les photos / les jaquettes portent le même nom que les titres des films
EX: apollo13 = apollo13.jpeg.

Les jaquettes sont dans le même dossier que le classeur "Excel 2007"
contenant la liste des films.

Une fois à destination, il serait génial que:
- chaque photos s'ajuste à la taille de chaque cellule de destination!.
(Cellule qui ont de même taille pour toute la colonne A).

Et donc ma 1 ère question:

Comment pourrais-je insérer (via une macro ou une formule) simultanément (ou par groupe de 10, 20 ou+) toutes ces centaines d'images JPEG et les faire s'ajuster à la taille de chaque cellule?


2) Par ailleurs, j'ai déjà créé des liens hypertexte, vers environ 1/3 de ces films,
c'est assez long à réaliser !

- Y à t'il plus rapide : une macro ou une formule magique? LOL.

Merci d'avance pour le temps que vous passerez à me répondre.


Amicalement

Felippe.

 

[Regueiro]

Re : J'ai Besoin d'aide !

Bonsoir
Allez voir sur le site de BOISGONTIER.
Lien ci-dessous.
Accueil - images.
À+

 

[Yaloo]

Re : J'ai Besoin d'aide !

Bonsoir à tous,

Voici un fichier avec une macro permettant de récupérer une image du même répertoire.

A+

Martial

PS : pour le second point, ça doit être faisable, mais il faudrait un fichier avec quelques exemples.

 

[felippe_75]

Re : J'ai Besoin d'aide !

Bonsoir Yaloo,

Je n'arrive pas à récupérer le code (clic droit sur Feuil1 - Visualiser le code=Option Explicit)
Et rien d'autre..?

Est-ce que ce code me permettra de télécharger (par groupes plusieurs dizaines de photos)
simultanément et de pouvoir les placer dans la colonne souhaitée?
ensuite j'aurai besoin qu'elles s'insère parfaitement sur chaque cellule de cette colonne.
Le but étant d'éviter de les placer une à une.

Merci de ton aide.

 

[Regueiro]

Re : J'ai Besoin d'aide !

Bonsoir à Tous
Le code de Yaloo se trouve sur module1.

Option Explicit

Sub Image()
Dim j&
For j = 1 To Cells(Rows.Count, 2).End(xlUp).Row
With Cells(j, 1)
.Activate
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Cells(j, 2) & ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.Top = .Top
Selection.Left = .Left
Selection.Height = .Height
Selection.Width = .Width
End With
Next
Range("A1").Select
End Sub

Comme le dit également Yaloo, peux-tu mettre ton fichier ainsi que 1 ou 2 jpeg
A+

 

[felippe_75]

Re : J'ai Besoin d'aide !

Re bsr,

Tout d'abord, merci à tous pour votre aide.

Ci-joint une partie de mon fichier.

J'aimerai pouvoir automatiser l'insertion des +1400 photos,
puis créer autant de liens hypertexte via une macro
afin d'éviter de les insérer 1 par 1.

Merci encore les amis.

Felippe

 

[Yaloo]

Re : J'ai Besoin d'aide !

Bonsoir Regueiro,

Le code cité plus haut par Regueiro, te permet d'importer les photos correspondant au nom de ton film et ce, pour toutes les cellules de la colonne B remplies.

A+

Martial

PS : S'il n'y a pas de fichier image, on passe à la ligne suivante.

Edit : Désolé, je n'avais pas vu ton message précédent.

 

[Yaloo]

Re : J'ai Besoin d'aide !

Maintenant, il faudrait savoir où se trouve tes films, pour créer les liens.

Je t'ai modifié ton fichier avec la macro.

A+

Martial

 

[felippe_75]

Re : J'ai Besoin d'aide !

re Bonsoir Yaloo,

Je bloque sur cette ligne de code.

ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Cells(j, 2) & ".jpg").Select


Mes photos sont dans ce dossier voici le chemin:
C:\Users\MA\Documents\EXCEL + FILMS\Jaquettes films

Comment dois-je adapter ton code?

Merci bien

 

[Yaloo]

Re : J'ai Besoin d'aide !

Re,

Les photos / les jaquettes portent le même nom que les titres des films
EX: apollo13 = apollo13.jpeg.

Les jaquettes sont dans le même dossier que le classeur "Excel 2007"
contenant la liste des films.

Tu indiques que les images sont dans le même dossier que le classeur. Il n'y a donc rien à toucher à la macro, puisque :

ThisWorkbook.Path

signifie que l'on cherche dans le répertoire de ce classeur.

As-tu essayé le fichier de mon post #8, j'y ai mis une gestion d'erreur si le fichier n'est pas trouvé.

A demain

Martial

 

[Yaloo]

Re : J'ai Besoin d'aide !

Re,

Mes photos sont dans ce dossier voici le chemin:
C:\Users\MA\Documents\EXCEL + FILMS\Jaquettes films

En te relisant il faut peut-être modifier comme ça, mais ça signifie que les jaquettes sont dans un sous-répertoire et non dans le même dossier.

ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\Jaquettes films\" & Cells(j, 2) & ".jpg").Select

Bon, cette fois, je vais me coucher.

A demain

 

[Regueiro]

Re : J'ai Besoin d'aide !

Bonsoir.
Une autre variante voir sur la feuille "MENU".
Tu choisis en B2 dans la liste de validation ton titre de film.
L'image vient automatiquement dans un contrôle image.
Ainsi tu n'importes aucunes photos et ton fichier sera mon lourd également.
A chaque ouverture de ton fichier, la liste des photos de ton répertoire se mettra à jour.
Voir depuis "H2"
J'ais mis le fichier au format *.xls
Car lorsque je l'enregistre au format *.xlsm il fait 13 méga ??

A+

 

[felippe_75]

Re : J'ai Besoin d'aide !

Bonsoir à tous ceux qui me liront!

En pièce jointe, les premières lignes de mon classeur "films"
mais avec seulement 2 jaquettes/ photos.
Elles sont pour la plupart téléchargées au minimum au format: 800x600 ou + en HD.

J'ai +1400 lignes (1 ligne = 1 titre de films) sur un classeur
et autant de jaquettes (au format jpeg) dans un dossier dédié,
les vidéos, elles, sont sur un DD externe.

En résumé:

Le but 1er est:

- De pouvoir récupérer/importer, la jaquette de chacun de mes films:
(classeur excel et jaquettes/photos jpeg, sont dans le même dossier, le tout sous w7);

- Que chaque photo s'insère simultanément (ou 10 par 10) dans la colonne A.

En face de chaque titre (les titres eux) sont dans la colonne B.

- Qu'elles s'ajustent toutes auto à leur cellule de destination.

- sans être obligé de les re-régler:
(via alt + clic G maintenu enfoncé, sur chacun des cotés de l'image)!


Le second objectif est:

De créer toujours auto ou simultanément (ou par groupes de plusieurs liens) des liens hypertextes:

- à partir de la cellule de chaque titre (et non de celle des photos) vers le film correspondant.


Le classeur excel sera finalement copié sur un DD externe, là où sont stockées toutes les vidéos,

afin d'être transportable (utilisable en vacances).

J'espère avoir été assez précis!

Sinon, c'est un sacré boulot que de tout faire 1par1, + tous les liens!

Donc s'il existe un moyen version auto? "J'achète...!"

Merci à chacun pour son aide.

Felippe

 

[Yaloo]

Re : J'ai Besoin d'aide !

Bonjour Felippe,

Pas de fichier en pièce jointe.

Le premier fonctionne dans le fichier du post #8, il suffit de modifier ton sous-répertoire.

Pour les liens hypertexte il faudrait avoir un peu plus de renseignement :
- Où se trouvent-ils dans ton disque ?
- Quel est le nom des fichiers ?

A te relire

Martial

 

[Yaloo]

Re : J'ai Besoin d'aide !

Re,

Avec cette macro ???

Option Explicit
Sub Image()
Dim j&
Application.ScreenUpdating = 0
For j = 1 To Cells(Rows.Count, 2).End(xlUp).Row
  With Cells(j, 1)
    .Activate
    On Error Resume Next
    ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Cells(j, 2) & ".jpg").Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.Top = .Top
    Selection.Left = .Left
    Selection.Height = .Height
    Selection.Width = .Width
  End With
  With Cells(j, 2)
    .Activate
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "Ton répertoire\Ton sous-répertoire\Apollo 13.avi", TextToDisplay:="Apollo 13"
  End With
Next
Range("A1").Select
Application.ScreenUpdating = -1
End Sub

A+

Martial