Photomaton

jojodanslalune

XLDnaute Junior
Bonsoir,

J'ai créé un bulletin pour les enfants. Tout est automatique: l'affichage du prénom, nom... en fonction du numéro d'ordre.

Je souhaiterais faire une dernière chose mais n'ai aucune compétence pour cela. Je possède une photo de chaque enfant. J'aimerais donc que cette photo s'affiche sur le bulletin de l'enfant. Seulement, c'est très fastidieux d'insérer manuellement cette photo pour chaque enfant.

L'idée serait donc que la photo s'affiche automatiquement.

Pour ce faire, les photos porteraient le prénom de l'enfant. Exemple: Vincent.jpg.

L'idée est donc que lorsque le prénom de Vincent apparait dans une cellule précise, la macro irait chercher l'image portant ce nom de fichier.

Est-ce possible?
 

Staple1600

XLDnaute Barbatruc
Dernière édition:

gbinforme

XLDnaute Impliqué
Re : Photomaton

bonjour jojodanslalune, le forum,

L'idée serait donc que la photo s'affiche automatiquement.

Pour ce faire, les photos porteraient le prénom de l'enfant. Exemple: Vincent.jpg.

Avec une macro de ce style, c'est possible.

Code:
Sub Image()
Dim rep As String
    rep = "C:\Mes documents\Mes images\"
    ActiveSheet.Pictures.Insert (rep & Range("A1").Value & ".JPG")
End Sub

L'idée est donc que lorsque le prénom de Vincent apparait dans une cellule précise, la macro irait chercher l'image portant ce nom de fichier.

Pour lancer automatiquement la macro, il faudrait que tu nous dises comment le nom est affiché ou tout simplement inclure le code dans ta macro d'affichage du nom.

à+
 

jojodanslalune

XLDnaute Junior
Re : Photomaton

Le prénom apparaît à partir d'une recherche dans la liste des enfants inclue dans une feuille du fichier.

L'introduction du numéro d'ordre fait apparaître les coordonnées de l'enfant. Ensuite, c'est une liaison de donnée pour faire apparaître le prénom sur chaque feuille.
 

gbinforme

XLDnaute Impliqué
Re : Photomaton

Bonsoir jojodanslalune, le forum,

L'introduction du numéro d'ordre fait apparaître les coordonnées de l'enfant. Ensuite, c'est une liaison de donnée pour faire apparaître le prénom sur chaque feuille.

Dans le code VBA de l'onglet où la saisie du numéro est effectuée, je te propose d'introduire cette macro :

Code:
Private Sub Worksheet_Change(ByVal sel As Range)
If Not Intersect(sel, Range("[b]B1[/b]")) Is Nothing Then ' remplacer B1 par la cellule de saisie du numéro
    Dim rep As String
    rep = "[b]C:\Mes documents\Mes images\[/b]"  ' remplacer par le chemin du répertoire photos
    With Sheets("[b]feuil2[/b]")         ' remplacer par nom de la feuille où l'on insère la photo
        .Range("[b]C1[/b]").Select      ' remplacer par nom de la cellule où l'on insère la photo
        .Pictures.Insert (rep & Range("[b]D1[/b]").Value & ".JPG")
    End With      ' remplacer par nom de la cellule où l'on trouve le prénom
End If
End Sub
 

jojodanslalune

XLDnaute Junior
Re : Photomaton

Bonjour,

J'ai donc modifié le code comme suit:

Code:
Private Sub Worksheet_Change(ByVal sel As Range)
If Not Intersect(sel, Range("D8")) Is Nothing Then ' remplacer B1 par la cellule de saisie du numéro
    Dim rep As String
    rep = "C:\Users\Vincent\Pictures\École\Vincent-Marie\03 septembre 2007"  ' remplacer par le chemin du répertoire photos
    With Sheets("Français")         ' remplacer par nom de la feuille où l'on insère la photo
        .Range("C1").Select      ' remplacer par nom de la cellule où l'on insère la photo
        .Pictures.Insert (rep & Range("F2").Value & ".JPG")
    End With      ' remplacer par nom de la cellule où l'on trouve le prénom
End If
End Sub

Seulement cela bloque. Le déboggeur s'arrête à .Range("C1).Select.

Je ne comprends pas pourquoi...
 

gbinforme

XLDnaute Impliqué
Re : Photomaton

bonjour jojodanslalune, le forum,

Si vous avez une idée de ce qui cloche...

Il y a plusieurs petites erreurs combinées :
- manque "\" en fin de répertoire.
- fallait activer la feuille
- manque "." devant range F2

Code:
    rep = "C:\Users\Vincent\Pictures\École\Vincent-Marie\03 septembre 2007[u]\[/u]"  ' remplacer par le chemin du répertoire photos
    With Sheets("Français")
        [u].Activate[/u]
        .Range("C1").Select         ' remplacer par nom de la feuille où l'on insère la photo
              ' remplacer par nom de la cellule où l'on insère la photo
        .Pictures.Insert (rep & [u].[/u]Range("F2").Value & ".JPG")

La programmation ne pardonne rien mais cette fois-ci, l'affichage devrait être au rendez-vous.

@+
 

jojodanslalune

XLDnaute Junior
Re : Photomaton

Bonjour,

D'abord, avant d'aller plus loin: un grand merci à tout ceux qui me donnent un coup de main !

J'ai modifié le code comme gbinforme me le conseille. Effectivement, avec ces erreurs, cela ne pouvait pas marcher ! Je n'ai pas encore l'oeil assez exercé pour repérer cela !

Plus de message d'erreur... mais la photo n'apparait pas. Qu'est-ce qui peut bien coincer dans l'histoire à présent?

Voici mon code actuel:

Code:
Private Sub Worksheet_Change(ByVal sel As Range)
If Not Intersect(sel, Range("D8")) Is Nothing Then ' remplacer B1 par la cellule de saisie du numéro
    Dim rep As String
    rep = "C:\Users\Vincent\Pictures\École\Vincent-Marie\03 septembre 2007\"  ' remplacer par le chemin du répertoire photos
    With Sheets("Français") ' remplacer par nom de la feuille où placer la photo
        .Activate
        .Range("C1").Select ' remplacer par nom de la cellule où placer la photo
        .Pictures.Insert (rep & .Range("F2").Value & ".JPG")
    End With      ' remplacer par nom de la cellule où l'on trouve le prénom
End If
End Sub
 

gbinforme

XLDnaute Impliqué
Re : Photomaton

re jojodanslalune

Plus de message d'erreur... mais la photo n'apparait pas. Qu'est-ce qui peut bien coincer dans l'histoire à présent?

En testant un peu plus, je pense qu'il faut penser à supprimer la photo précédente sinon tu auras vite du surplus.
J'ai aussi testé la présence de la photo pour éviter les erreurs dans le code modifié.
Le code entre "With ..." et " End With " peu être dupliqué pour chaque feuille où la photo est souhaitée où l'on peut le faire automatiquement avec une boucle : à voir.

Code:
Private Sub Worksheet_Change(ByVal sel As Range)
If Not Intersect(sel, Range("D8")) Is Nothing Then ' remplacer B1 par la cellule de saisie du numéro
    Dim rep As String
    rep = "C:\Users\Vincent\Pictures\École\Vincent-Marie\03 septembre 2007\"  ' remplacer par le chemin du répertoire photos

    With Sheets("Français") ' remplacer Français par nom de la feuille où l'on insère la photo
        .Activate
        .Range("C1").Select ' remplacer C1 par nom de la cellule où l'on insère la photo
        Dim photo As Object ' declaration variable image
        For Each photo In ActiveSheet.DrawingObjects ' boucle pour tous les objets
            If ActiveCell.Address = photo.TopLeftCell.Address Then
                photo.Delete ' on efface la photo précédente
            End If
        Next
        If Dir(rep & .Range("F2").Value & ".JPG") = "" Then
            .Range("C1").Value = "Pas de photo" ' test existance photo éléve
            MsgBox ("photo inexistante") ' ligne à supprimer pouréviter le message erreur
            Exit Sub
        End If
        .Pictures.Insert (rep & .Range("F2").Value & ".JPG")
    End With      ' remplacer F2 par nom de la cellule où l'on trouve le prénom

End If
End Sub

Par contre la photo devrait s'afficher à condition que tes photos soient bien en "jpg" sinon il faut modifier '& ".JPG")' avec le bon type de photo.

@+
 

jojodanslalune

XLDnaute Junior
Re : Photomaton

J'ai encore un soucis avec le code:

La photo s'affiche bien mais pas dans la bonne cellule. Elle devrait apparaître dans C1 mais elle apparaît dans la colonne B...

Ensuite, la photo ne s'efface pas lorsque je change d'enfant... sans doute à cause du fait qu'elle ne se trouve pas au bon endroit. Pourtant, je regarde le code et ne comprends pas pourquoi cela réagit de la sorte. Tout me semble conforme...
 

gbinforme

XLDnaute Impliqué
Re : Photomaton

Bonsoir jojodanslalune, le forum,

Je rectifie ce que j'ai dit: cela fonctionne très très bien sous Excel 2003 mais pas sous Excel 2007. Cela m'ennuie un peu, je voudrais que cela soit compatible sur les deux versions...

Effectivement, j'ai testé sur 2003, j'ai prêté le portable que j'ai pour 2007 et ne peut pas tester. C'est cependant curieux, car c'est du code basique qui est utilisé et si 2007 confond B1 avec C1, cela devient grave. D'autre part, c'est plutôt dans le sens inverse que l'on devrait avoir des soucis.

En fait je crois que tu devrais essayer de descendre la ligne :

.Range("C1").Select ' remplacer C1 par nom de la cellule où l'on insère la photo
devant :
.Pictures.Insert (rep & .Range("F2").Value & ".JPG")

Le problème vient peut-être et sûrement, de la suppression et du test que j'ai rajoutés entre les deux.

Essaies cela, cela devrait réparer.

@+
 

Discussions similaires

Statistiques des forums

Discussions
312 392
Messages
2 088 000
Membres
103 691
dernier inscrit
christophe89