Excel + photos dans les commantaires

[yorrick]

bonjour,

Voici un petit casse tete voir un gros .....

J'ai un fichier qui contient environ 2000 Lignes ...

En A2 j'ai une reference style 1-15210 et dans un repertoire de
windows j'ai une photo qui s'appelle 1-15210.gif

J'aimerais pouvoir mettre cette photo dans un commentaire
bien entendu il en va de meme pour les 1999 autres lignes ...

Je sais qu'il est possible, via inserer un commentaire clic droit
commentaire, format de cellule commentaire, couleur, motif et texture
image ... et de definir l'image associé au commentaire.

Mais cette manip est longue, et a faire pour 2000 lignes je vous laisse imaginer la chose ...

Alors si vous avez des idées, je vous en prie nb'hésitez pas car là je ne voit pas comment faire.

Merci d'avance

Yorrick

 

[Vériland]

Bonsoir Yorrick et le forum,

Voici une macro qui a pour principe de faire ce que tu désires...

En faisant un "clic droit" sur une cellule quelconque cela ouvre une boite de dialogue vers le chemin où se trouve l'image (ici bureau) qu'il te reste plus qu'à selectionner...

ensuite l'image s'insère dans le commentaire...

Option Explicit

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' Insérer un commentaire puis une image
' après clic droit souris sur la cellule
' Vériland
' Juin 2003
Cancel = True
Dim MonImage
ActiveCell.AddComment
ChDrive "C"
ChDir "C:/windows/bureau"
MonImage = Application.GetOpenFilename
If MonImage = False Then Exit Sub
ActiveCell.Comment.Shape.Fill.UserPicture MonImage
End Sub

tu vas certrainement gagner du temps là...lool

PS : Macro à copier depuis le forum auquel cas tu risques d'avoir les attributs du post dedans

 

[@+Thierry]

Hello Hello,

Je passe un ptit moment sur mon ordi perso chez moi, que j'avais pas encore allumé !!

Très bien Vériland, mais de mon coté j'ai bien noté que Yorrick devait faire çà sur pas mal de rows...

Alors j'ai rebricolé Lien supprimé que j'avais fait pour notre ami Mytå...Juste pour le Fun

Par contre faut faire tourner çà sur une bête de course... Sinon "Out of Memory" assuré, il faut un max de mémoire virtuelle pour que çà tourne...

Je n'ai pas non plus testé sur 2000 photo... alors ptet que çà va pas se faire... (Si problème, définir des tranches de zones à couvrir à la place de 1 To Range("A65535").End(xlUp).Row, mettre de 1 to 100, puis changer manuellement 101 to 200... etc... Mais çà devrait tout de même aller plus vite que 2000 clicks droits...lol

Sub Image_commentaire()
Dim i As Integer
Dim Limage As String

For i = 1 To Range("A65535").End(xlUp).Row
If Range("A" & i).Value <> "" Then

Limage = Range("A" & i) & ".gif"

With Range("A" & i)
.ClearComments
.AddComment
.Comment.Visible = False
With Range("A" & i).Comment.Shape
.Fill.UserPicture "C:\Mes documents\Mes images\" & Limage
.ScaleHeight 3#, msoFalse, msoScaleFromTopLeft
.ScaleWidth 3#, msoFalse, msoScaleFromTopLeft
End With
End With
Else
Range("A" & i).ClearComments
End If
Next i
End Sub

Je ne suis pas arrivé par contre à appliquer "PictureFormat" avec des constantes xlStackScale ou xlStack... et par défaut les photos seront plutôt xlStretch (déformées...) Mais si les Photos Gif de Yorrick sont toutes d'une taille standard, il suffira de peaufiner sur la valeur de ScaleHeight (par exemple 3.55 au lieu de 3#) afin d'avoir une taille correcte et une déformation minime...

Enfin je répète que çà à l'air de bouffer un max de ressources (j'ai dû quitter toute autre application et même faire tourner juste après un reboot pour que çà passe)

merci encore au fait Vincent !

Bonne soirée

@+Thierry

 

[Vériland]

Hello Thierry,

loool

Ben te voilà avec une nouvelle signature hi hi hi...tout en couleur

Oui tu as raison question memoire...il faut avoir pas mal de ressources là...(ouarf)...surtout lorsqu'on ajoute toutes les images...mais tu sais à ce propos je me demande si ce principe ne serait pas plus facile à adapter dans un userform, où selon la selection de la donnée dans la cellule s'affiche l'image en question qui est lu directement sur le disque...

Je sais c'est pas le sujet de l'userform ici mais je crois que cela solliciterait déjà moins de ressources mémoires...

Bon j'ai fait vite fait un p'tit exemple dans le fichier avec ma macro...ça se passe sur la feuille 3...mais tu vas certainement y apporter la 3° dimension...looooool

Bonne soirée ;-)

 

[yorrick]

Tout d'abord merci a tous les deux .....

Cette macro fonctionne du tonerre .........

Sur 2000 Lignes il ne m'a pas fallut + une minute pour que l'ensemble
fonctionne ( j'ai recopier sur les 2000 lignes la meme reference) et le poid
du fichier est parfaitement convenable ..... environ 2,35 Mo sur une photo de
base de 30ko.

Par contre comme dit @+thierry il reste le souci de la taille du commentaire
mais cela doit etre possible de modifié les dimensions de l'image d'origine.

Mais car il y'a toujours un mais dans ces cas là, j'ai essayé de lancer la macro sur une serie avec des reference en A?? qui n'a pas sa photo
et bien là ca bogue alors est il possible de faire quelque chose dans ce genre de situation.

COrdialement

Merci

YOrrick

 

[@+Thierry]

Bonsoir Yorrick

Heureux de savoir que çà tourne du tonerre !!! (j'avais un peu peur !!, tu dois avoir une bonne bécane)

Pour ton mais tu veux dire quoi ? En A " i " je fais un test pour savoir si la cellule n'est pas vide... Maintenant si elle n'est pas vide, je pensais que celà signifiait que c'était le nom d'un GIF ?

Enfin tu peux toujour intégrer un "On Error Resume Next" ... comme ceci

If Range("A" & i).Value <> "" Then
On Error Resume Next
Limage = Range("A" & i) & ".gif"

Je pense que çà devrait passer et donc ne rien faire sur les cellules ne contenant pas un nom de GIF existant....

Tiens nous au courant
Bonne Nuit
@+Thierry

 

[yorrick]

Merci de ta rapidité de reponse ....

Je test ca demain puisque que mon excel est en rade chez moi
(je ne peu plus rien faire dessus), il me reste celui du boulot ....


je vous tiens z'au courant ...

P.S. : pour la becane P4 2ghz + 512 ddr

 

[yorrick]

Me revoilou avec mes modifs sur cette macro .....

Donc thierry la modif que tu m'a indiqué fonctionne parfaitement
sauf que comme toujours le francais moyen (aujourd'hui c'est moi)
n'est jamais content ....

Alors j'aimerais savoir s'il est possible d'améliorer un poil la macro.

Voici les modifs qu'il me manquerait pour arriver à la perfection ...

1° - Si il n'y a pas de fichier photo alors ne pas créer de commentaire un peu comme quand la celulle est vide ...

2° - Y'a t il selon toi un moyen pour faire en sorte que l'on puisse avoir
des images en extension .gif & .jpg dans le répertoire.

3° - Selon toi il n'ya aucun moyen de permettre a un commentaire de prendre la taille de la photo (sachant que la photo ne fera jamais un A4)

merci d'avance

si tu n'a pas le temps de regarder je chercherait les modif a apporter mais on s'est mis a deux durant 30 minutes et on a rien reussi a faire.

 

[@+Thierry]

SAlut Yorrick

Humm on s'enlise dans ce fil !! lol

Je pense que pour 1) il faudrait plutot faire une "remontée" vers le répertoire sensé contenir le nom de fichier indiqué dans la cellule "A i"... Mais celà necessite de faire une boucle pour chaque cellule pour tester l'existance du fichier, ainsi si une erreur est retournée on zap cette cellule... sion poursuit la création du commentaire....

Pour le 2) dans la même boucle il faudrait faire une double, ou triple test... pour tester : limage & ."gif", si false : limage & ."jpg", etc...

Pour le 3), je n'ai rien trouvé à l'époque comme je l'ai expliqué en essayant de m'appuyer sur "PictureFormat" pour pouvoir appliquer des constantes xlStackScale ou xlStack, qui selon mes tests ne semblent être "comprises" par un commentaire... Mais çà n'engage que moi, je ne suis pas vraiment un spécialiste des Comments, je n'ai fait que m'amuser avec...

Enfin pour conclure, je pense que tu devrais faire deux ou trois choses, car sinon tu vas monter une usine à gaz.... Car les boucles si dessus en plus du travail conséquent de la première que je t'ai déjà donnée vont être plus que lours à gérer.....

Premièrement tu remonte tous les gifs, jpg, etc contenu dans le répertoire où tu as tes photo...

Voici une macro pour faire ceci, ce code va lister tous les fichiers d'un répertoire précis :

Sub Liste_Fichiers()
Dim ChercheFichier As FileSearch
Dim Chemin As String
Dim I As Integer
On Error Resume Next
Set ChercheFichier = Application.FileSearch
Chemin = "D:\Mes Documents\"
With ChercheFichier
.NewSearch
.Filename = "*.*"
.LookIn = Chemin
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
Cells(I, 1).Value = Dir(.Item(I))
Next I
End With
Else
MsgBox "Pas de Fichier trouvé dans " & Chemin
End If
End With
Set ChercheFichier = Nothing
End Sub

Ensuite tu peux même masquer cette colonne qui contiendra que des fichiers existants avec leur extension ".gif", ".jpg" etc etc....... Et qui permettra à la boucle de pointer directement sur le bon fichier... Tu vois, au moins tu n'auras pas à faire une usine à gaz...

Enfin moi je vois çà comme çà...

Bonne Nuit
@+Thierry

 

[yorrick]

Tu as parfaitement raison ......

Je suis en train de monté une usine a gaz .......

Je vais gardé la macro comme tel, libre a moi de grace a des logiciel de convertir toutes mes photos dans un format identiques.....

Puis pour les ceux qui n'ont pas de commentaire, je ne sais pas si c'est possible via une macro de supprimer les commentaire n'ayant pas de image en papier peint ???

Voici maintenant ma recherche .......

Mais thierry , je te remercie encore une fois car tu m'a enlevé une grosse
épine du pied ....

Cordialement,

Yorrick