Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier Excel.

[Karim]

Bonjour à tous,
Je suis dans mes débuts avec les Macro, et je fait bcp de copier / coller...

Donc je vous exprime mon souci si quelqu'un a une idée:
J'ai appliqué le code que j'ai trouvé dans un fichier Excel.
Le BUT de ce Code est de prendre des photos qui ce trouve dans un emplacement que l'on renseigne dans une cellule (K2), et de les insérer toutes d'un seul coup en un clic..

ça Fonctionne mais les photos apparéssent seulement quand le fichier xls est dans mon PC, (ça ne copie qu'un lien et non la photo en dur..)
Quand j'envoie mon fichier à un collégue il ne peut pas voir les photos..
Si je déplace les photos du dossier d'origine (K2) c'est pareille..

Je voudrais SVP une solution si vous pouvez m'aidez à ce que les photos soit inséré rééllement et définitivement.

Merci d'avance(Fichier joint)

En plus
Ci-joint le code:

Sub InsertionImages()

Dim Repertoire As String
Dim Extension As String
Dim Fichier As String
Dim chemin As String
Dim final As String

chemin = Sheets("Photo").Range("K2")
final = chemin & "\"

'Saisie du nom du répertoire
Repertoire = InputBox("Chemin complet du répertoire (\ à la fin)", "Répertoire", final)

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 5 photos
X = 0
If l = 23 Then
c = c + 13
l = 2

End If

If l = 7 Then
l = l + 1
X = 1

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

'ActiveSheet.Pictures.Insert(ficimg).Select ' insertion

Selection.Name = Fichier
Selection.ShapeRange.LockAspectRatio = msoFalse
With ActiveSheet.Shapes(Fichier)

.Top = Cells(c, l).Top
.Left = Cells(c, l - X).Left
.Height = Range(Cells(c, l), Cells(c + 11, l)).Height
.Width = Range(Cells(c, l), Cells(c, l + 4 + X)).Width

End With

Range("A1").Select
Fichier = Dir
Loop

End Sub

 

[Karim]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Peut etre un parametrage d'excel 2010..

 

[Karim]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

A l'aide

 

[Karim]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Personne pour mon probléme???
Svp

 

[mapomme]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Bonjour Karim,

Personne pour mon probléme???
Svp

Je n'ai examiné votre code que très succinctement . Très vite, je me suis dit (si, si ): "plutôt que d'indiquer en dur le chemin dans le fichier et de demander à l'utilisateur l'extension, pourquoi ne pas lui faire sélectionner un fichier image dans le répertoire et avec l'extension qui vont bien". Ainsi on pourra récupérer à la fois le répertoire ainsi que l'extension à traiter.

De plus, très récemment, j'avais fait un code pour charger une image et l'insérer à l'emplacement d'une cellule (ou d'une plage) même si la cellule fait partie d'une plage de cellules fusionnées.

De là, j'ai pondu ce fichier qui peut-être pourra vous servir ainsi qu'à vos collègues (ça m’intéresse de connaître le résultat si vous donnez suite...)

Attention, il y a des constantes au début du module. Leur nom devrait suffire à savoir leur utilité et comment les renseigner.

Notez que dans le fichier initial que vous avez fourni,une des colonnes photo n'avaient pas la même largeur de cellules fusionnées que les autres. Ça m'a pris quelque temps avant de m'en apercevoir !

Le fichier fourni est à déziper. Il comporte le fichier et un répertoire avec des images de test.

On peut:

• télécharger toutes les images d'un répertoire donné avec une extension donné
• remplir les cartouches sous chaque photo avec le nom du fichier (sans le chemin et sans l'extension)
• ou bien remplir les cartouches avec un nom générique (Photo nn)
• effacer toutes les photos et les cartouches

Le placement d'une image dans une plage de cellules met l'image à la taille de la plage, tout en conservant les proportions de l'image chargée. C'est pourquoi l’image ne couvre que très rarement toute la surface de la plage. Seule une dimension de l'image (soit la largeur soit la hauteur) s'adapte à une dimension de la plage. C'est voulu !

(J'ai aussi joint)le fichier Excel seul)

Errata 1 : j'avais oublié une partie du code. C'est rajouté dans la version v1a ICI.

 

[mapomme]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Re,

Je suis confus. J'avais oublié l'option qui consiste la première fois à afficher le répertoire du fichier excel puis de conserver le dernier répertoire sélectionné par l'utilisateur dans la fenêtre de dialogue. C'est dans la version v1a.

 

[Karim]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Bonjour Mapomme ;-)

Super votre fichier, vraiment bien, j'aimerais bien pouvoir l'utiliser mais il a le même probléme que celui que j'utilise.
Tous fonctionne bien jusqu'a ce supprime le dossier Photo ou que je le renomme, pareille si j'envoie le fichier par mail, les photos ne sont pas lisible d'un autre apareil (styl Ipad ou Iphone).

Un amis m'a conseillé d'utiliser : "Shape.AddShape" à la place de "Picture.Insert".
Je n'ai pas réussi à l'adapter à votre fichier..

Je vous joins la photo

 

[mapomme]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Bonjour Karim

(...) Tous fonctionne bien jusqu’à ce supprime le dossier Photo ou que je le renomme, pareille si j'envoie le fichier par mail, les photos ne sont pas lisible d'un autre appareil (...)

Hé bien j'avais oublié le point le plus important !!! Cette version v2 devrait corriger la chose. Faites le moi savoir si vous voulez bien... Elle devrait aussi mieux gérer les mises à l'échelle des images (il me semble).

A+

 

[Karim]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Bonjour,
Merci j'ai pris l'onglet hier et l'ai adapté dans mon fichier de maintenance, j'ai effectué tous les essai et c'est vraiment nikel..
Encor merci.
un seul petit beug dans le nommage des photos en "Photo XX" le suite n'ai pas la bonne, ça fais photo1 jusqu' photo 4, puis ça descend en bas et ça commence par photo 2..

Encor merci

 

[mapomme]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Bonsoir Karim,

(...)
un seul petit beug dans le nommage des photos en "Photo XX" le suite n'ai pas la bonne, ça fais photo1 jusqu' photo 4, puis ça descend en bas et ça commence par photo 2 (...)

Comme quoi, on ne vérifie jamais avec assez d'attention !

Voici la version v2a qui doit corriger ce point

 

[Karim]

Re : Probléme pour inserer plusieurs Photo définitivement d'un coup dans un fichier E

Bonjour Mapomme,
Comment allez vous? j'ai abusé cette année de la version V2a qui ce trouve au dessu, merci encore!!

J'aurais cette fois ci une nouvel demande à vous faire svp, serait-il possible d'intégrer dans le code un redimentionnement de la photo, bcp d'utilisateur ne reduise pas les photos avant de les insérer, 40 à 50 photos à 2Mo dans le fichier excel alourdissaient trop le fichier.

si cela est possible d'avoir une reduction a 200ko environ par photo ou si c'est pas possible une restriction impossible d'insérer une photo de plus 250Ko

Merci d'avance