XL 2010 Afficher une image en passant sur une cellule

Bentfp26

XLDnaute Nouveau
Bonjour à tous,

Je suis nouveau sur le forum et pas très à l'aise avec les "us et coutumes" des forums en général......

donc je vais essayer de bien faire, tant en matière de présentation que pour exposer mon problème...

46 ans, chauffeur de direction et aussi président d'une asso loi 1901, je maîtrise moyennement excel mais je suis curieux, (ça c'est pour la présentation, sommaire, je vous l'accorde !).

Mon problème ( ou plutôt ce que je n'arrive pas à réaliser):
voilà, donc j'ai fait un petit tableau ( très simple, j'en conviens) pour la gestion de la collection de pièces de 2€ commémoratives que j'ai commencée avec le fiston ( bon c'est vrai que lui est nettement moins assidu que moi!!!) et j'ai un fichier d'images par année et par pays des pièces de 2 €.
J'aimerais avoir la possibilité d'afficher une image de la pièce quand je passe sur la cellule correspondante, sans avoir à cliquer et que cette image s’efface quand je ne suis plus sur la cellule....
Une chose que je souhaiterais également c'est que tout soit sur le même fichier, c'est à dire que je puisse me balader avec ma clé USB, ou partager mon fichier sans avoir a envoyer plusieurs documents pour que ça fonctionne.... ( je ne sais pas si je me suis bien fait comprendre.....)

J'ai effectuer plusieurs recherches mais je dois avouer que je n'ai pas compris grand chose à ce qui était expliqué et aux solutions proposées....

Si quelqu'un a une solution à me proposer ( et surtout la patience de m'expliquer car le but étant que je comprenne un minimum ce que je fais) je l'attend avec impatience !!!
Donc je mets en pièces jointes mon tableau (pour le dossier "images" je n'arrive pas à le téléverser!!)

Un grand merci par avance pour votre aide.
 

Pièces jointes

  • 2EUROS COMMEMO.xlsx
    131.4 KB · Affichages: 37

Lone-wolf

XLDnaute Barbatruc
Bonjour Patrick, Bernard, Benoît, le Forum :)

@patricktoulon : tu n'as pas tout suivi ;).

Lone-wolf à dit:

1.- Combiens d'images en tout tu as dans le dossier?

2.- Tu dit ceci: sous le format nom de fichier: année - pays - nom de la pièce .jpg

Mais dans ton fichier exemple, dans la colonne des noms tu as des zéros.
Ce qui veux dire qu'il n'y a pas de nom (donc pas d'image), What'is??

Benoît à dit:

2- le nombre d'images n'est pas le même que le nombre de pièces ( en effet, pour les allemandes je ne mettrai qu'une image pour chaque séries de pièces, une série étant composée de 5 pièces A, D, F, G, J).
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour lone-wolf
re
la base de l’apparition se fait avec le test dir donc si la pièce n'existe pas le commentaire ne sera pas créé
le nom correspondant en colonne "I" est numeroté de 1 a X je ne vois pas trop ce que je n'aurais pas suivi

maintenant si les noms doivent changer il adaptera , le B a BA du VBA
 

Lone-wolf

XLDnaute Barbatruc
Re Patrick,

@patricktoulon

Les noms mis en colonne I, c'est moi qui l'ais-ai mis comme exemple, puisque notre ami n'a pas parler de noms dans son premier message.

je ne vois pas trop ce que je n'aurais pas suivi
Pourtant mon précédent message est assez explicit (ou parlant si tu veux). Si tu aurais suivi le fil, t'aurais évité de faire tout ce travail pour rien.

EDIT: comment tu fait pour avoir l'image gif? À moins que ce soit une video tranformée en gif.
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Bentfp26, Lone-wolf, patricktoulon,

En l'absence de réponse à mon post #14 voici une solution très simple :
Code:
Sub CréerCommentaires()
Dim dossier$, fichier$, n&
dossier = ThisWorkbook.Path & "\Images\"
fichier = Dir(dossier & "*.jpg") '1er fichier du dossier
Range("A2:A" & Rows.Count).Delete xlUp 'RAZ
n = 1
While fichier <> ""
    n = n + 1
    Cells(n, 1) = Left(fichier, Len(fichier) - 4) 'nom du fichier sans l'extension
    With Cells(n, 1).AddComment("").Shape
        .Width = 150 'dimension à adapter
        .Height = 150 'dimension à adapter
        .Fill.UserPicture dossier & fichier
    End With
    fichier = Dir 'fichier suivant
Wend
End Sub
Le fichier Collection(2).xlsm est rempli uniquement avec le contenu du dossier "Images".

Fichier (2) et dossier joints.

A+
 

Pièces jointes

  • Collection(2).zip
    48 KB · Affichages: 46

patricktoulon

XLDnaute Barbatruc
re
bonjour lone wolf oh!! oui il y en a des tas de captureur gif .Celui la est assez simple
tu peut même gérer le nombre d'image pas seconde comme une vidéo en fait
et l'avantage de celui ci c'est que il créée les images seulement en fonction de se qui change dans l’écran
ce qui réduit considérablement le poid de l'image animée finale
 

Lone-wolf

XLDnaute Barbatruc
Re Patrick

@patricktoulon : effectivement, une fois qu'une image est réduite puis savegardée en.gif, le poids de l'image est plus léger.
Moi j'utilise Photophiltre Studio pour ça. Ici les images ont la même dimension; un peu plus de 7Ko pour un gif, 59Ko pour un jpg.
 

Pièces jointes

  • impression.gif
    impression.gif
    7.3 KB · Affichages: 43
  • impression.jpg
    impression.jpg
    62.2 KB · Affichages: 42

patricktoulon

XLDnaute Barbatruc
non tu n'a pas compris
avec lice cap imagine tu a une animation a l'ecran avec un paysage et un ballon qui roule et bien l'image1 du gif sera le paysage et les autre images seront juste les parti qui sont différente de la précédente plus petite et placé dans le masque au lieu d'avoir une image complète nouvelle a chaque changement ça allège bien évidement le poid du fichier gif ,en plus le réglage du bitrate en bas a gauche qui est réglé a 8 d'origine je crois, moi je l'ai mis a 4 pour des capture excel c'est amplement suffisant
c'est ça qui le rends super car les autres ne font pas pareil
si tu a gimp ou même photoshop tu peux voir les calques d'un gifs regarde les sur une gif pris avec lice cap et il encode très vite en plus quasiment instantanément
 

job75

XLDnaute Barbatruc
Bonjour le fil, le forum,

Pour créer des fichiers GIF à partir de fichiers JPEG c'est facile :
Code:
Sub CréerFichiersGIF()
Dim dossier$, fichier$
dossier = ThisWorkbook.Path & "\Images\"
fichier = Dir(dossier & "*.jpg") '1er fichier JPEG du dossier
Application.ScreenUpdating = False
While fichier <> ""
    With Me.Pictures.Insert(dossier & fichier) 'crée la Shape
        .CopyPicture
        With Me.ChartObjects.Add(0, 0, .Width, .Height).Chart
            .Paste
            .Export dossier & "\" & Left(fichier, Len(fichier) - 4) & ".gif", "GIF"
            .Parent.Delete 'supprime le graphique temporaire
        End With
        .Delete 'supprime la Shape
    End With
    fichier = Dir
Wend
End Sub
Fichiers joints.

A+
 

Pièces jointes

  • Fichiers GIF(1).zip
    48.3 KB · Affichages: 31

patricktoulon

XLDnaute Barbatruc
Bonjour job 75
re
oui l'export avec un chart on connait je pense on parlait de gif animées ce qui était une parenthèse
pour ça non il te faudra WIA
mais encore une fois ca n'etait qu'une parenthèse lone wolf était seulement intéressé par le moyen que j'utilisais pour capturer mes démo excel en gif animées
et entre nous question qualité l'export du chart pasté de l'image c'est pas jojo
je préfère l'exporter avec les api (oelacreate un guid,un dispatch ) tu trouve cet exemple partout
de plus ma préférée a moi et simplement l'export en wmf qui me permet de garder les transparence intégrale et demie transparence

pour clore cette parenthèse voila une version qui sauve une copie d'un shape ou d'une plage dans un fichier temps et le renvoie dans un control image d'un userform
question qualité c'est du HD!!

le code en est tellement simple que j'ai hésiter a le montrer

Code:
Private Declare Function GetTempFileNameA Lib "Kernel32" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function CloseClipboard Lib "user32" () As Long

Private Declare Function GetClipboardData Lib "user32" (ByVal uFormat As Long) As Long

Private Declare Function CopyEnhMetaFileA Lib "gdi32" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long

Private Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hDC As Long) As Long

Private Sub CommandButton1_Click()
CopiePhoto Range("A1:f30")
    'CopiePhoto ActiveSheet.Shapes(1), 0, 0
End Sub
Sub CopiePhoto(Source As Variant, Optional transparency As Long = 1, Optional borders As Long = 0)
    Dim FichTemp As String
    FichTemp = Space(160)
    GetTempFileNameA Environ("TMP"), "IMG", 0, FichTemp
    FichTemp = Left$(FichTemp, InStr(FichTemp, vbNullChar) - 1)
    'Debug.Print FichTemp
    Source.Copy 'Picture
    OpenClipboard 0
    DeleteEnhMetaFile CopyEnhMetaFileA(GetClipboardData(14), FichTemp)
    CloseClipboard
    On Error Resume Next
    With Me.Image1
        .Picture = LoadPicture(FichTemp)
        .BackStyle = transparency
        .BorderStyle = 0
        .Move .Left, .Top, Source.Width, Source.Height
    End With
    Kill FichTemp
End Sub

toujours est il que plus de nouvelle de la part du demandeur
 

Discussions similaires