macro pour insérer une image

Question

Bonjour,
J'ai créé un petit pgm de classt d'un concours de pétanque. Pour agrémenter la liste des résultats, je voudrais insérer une image de coupe en face de la ligne comportant la 1ère femme.(position aléatoire en fonction du classement)
Voilà le bout de code que j'ai écris mais je n'arrive pas à faire apparaître mon image.Je n'ai aucun message d'erreur.
Merci de votre aide. 
Cordialement.

Dim Compteur As Long
Dim maCellule As String

Compteur = 6
Do While ((Sheets("Classement").Range("I" & Compteur).Value))
maCellule = Sheets("Classement").Range("I" & Compteur).Value
If maCellule = "1ère Femme" Then
ActiveSheet.Pictures.Insert("E:\Mes images\Mes images\Albums\Images Coupe1.jpg").Select
Compteur = Compteur + 1
End If
Range("I6") = Compteur
Loop

cs_Le Pivert · Answer

Bonjour,
Tout d'abord il faut éviter les chemins en dur. Mettez vos images dans un dossier avec votre classeur Excel. 
Voici une macro pour insérer une image dans une cellule donnée en l'occurence A1 avec une image "MonImage.jpg" qui se trouve dans le dossier avec la classeur:
On Error Resume Next
Fichier = ActiveWorkbook.Path & "" & "MonImage" & ".jpg" ' On cherche le fichier image
Range("A1").Select
    ActiveSheet.Pictures.Insert(Fichier).Select

En partant de là il vous sera facile de continuer.

@+Le Pivert

gerardmireille · Answer

Bonjour,
Je suis d'accord pour éviter les chemins en dur mais le problème sur lequel je butte est le suivant : Je ne veux pas que mon image soit insérée dans la cellule A1 mais dans la cellule qui se trouve à côté de la mention "1ère Femme"
qui peut être aussi bien en "I1" qu'en "I50".
Merci d'avance 
Cordialt

cs_Le Pivert · Answer

Je vous propose une macro qui cherche le mot, qui sélectionne la cellule à droite et qui insère une image.

Sub RechercheMot()
Dim Var As String
Dim Fichier As String
On Error Resume Next
Fichier = ActiveWorkbook.Path & "" & "MonImage" & ".jpg" ' On cherche le fichier image
Var = "1ère Femme"'vous pouvez mettre un TextBox
If Var = "" Then Exit Sub
Set MotTrouvé = Cells.Find(What:=Var)
If Not MotTrouvé Is Nothing Then
MotTrouvé.Select
ActiveCell.Offset(0, 1).Select
    ActiveSheet.Pictures.Insert(Fichier).Select
Else
MsgBox "Rien trouvé"
Exit Sub
End If
End Sub

Vous pouvez mettre un TextBox pour saisir le nom recherché, vous modifierez le code.
Il faut que le mot soit rigoureusement exact. Il peut se trouver n'importe où sur la Feuille.
Faites un essai et dites-moi si cela correspond à ce que vous voulez.
@+ Le Pivert

cs_Le Pivert · Answer

Je vous ai fait un petit programme 
1 UserForm
2 Boutons
1 TextBox ou ComboBox (si ce sont toujours les mêmes données)

Dim Fichier As String
Dim Var As String
Private Sub CommandButton1_Click()
Fichier = Application.GetOpenFilename( _
    "Fichiers Image (*.jpg;*.gif;*.png;*.tif;*.bmp),*.jpg;*.gif;*.png;*.tif;*.bmp")
End Sub
Private Sub CommandButton2_Click()
If TextBox1 = "" Then
MsgBox "Entrez un nom!"
Exit Sub
Else
RechercheMot
End If
End Sub
Sub RechercheMot()
On Error Resume Next
Var = TextBox1 ' ou ComboBox
If Var = "" Then Exit Sub
Set MotTrouvé = Cells.Find(What:=Var)
If Not MotTrouvé Is Nothing Then
MotTrouvé.Select
ActiveCell.Offset(0, 1).Select
    ActiveSheet.Pictures.Insert(Fichier).Select
Else
MsgBox "Rien trouvé"
Exit Sub
End If
End Sub


Avec ce programme vous saisissez le nom et allez chercher le fichier image.


@+ Le Pivert

gerardmireille · Answer

Merci pour tes informations :
J'ai quelques soucis pour créer le fichier contenant mon image.
J'ai toutefois testé ton programme en conservant le chemin en dur.
Mon image apparait dans la feuille excel mais si le mot "1ère Femme" se trouve dans une autre cellule de la même colonne, l'image reste toujours au même endroit. Ci dessous mon code :

Dim Var As String
Dim Fichier As String
On Error Resume Next
'Fichier = ActiveWorkbook.Path ???????? A REVOIR
Var = "1ère Femme"
If Var = "" Then Exit Sub
Set MotTrouvé = Cells.Find(What:=Var)
If Not MotTrouvé Is Nothing Then
MotTrouvé.Select
ActiveCell.Offset(1, 2).Select
    ActiveSheet.Pictures.Insert("E:\Mes images\Mes images\Albums\Images Coupe1.jpg").Select
Else
MsgBox "Rien Trouvé"
Exit Sub
End If
End Sub

Merci de ton aide
Cordialt

cs_Le Pivert · Answer

Si 1ère Femme est presente plusieurs fois sur la Feuille, cela n'en sélectionnera qu'une.
Pour le fichier image il y a le code du CommandButton1 qui permet une recherche du fichier Image à chaque fois.
Si tu mets ton fichier image avec le classeur, cela sera plus compliqué si il y a plusieurs images à appeler.
@+ Le Pivert

gerardmireille · Answer

Bonjour,
Désolé mais "1ère Femme" n'apparaît qu'une seule fois dans la liste.
A titre indicatif une formule de recherche est positionnée dans chaque cellule de la colonne.
Pour le fichier je n'ai qu'une seule image à faire apparaître.
Est ce que tout cela t'éclaire ?
Merci d'avance
Cordialement
GM

cs_Le Pivert · Answer

Voici une nouvelle approche:
1 UserForm
1 ComboBox
Les images sont dans un dossier avec le classeur et portent le même nom que le mot recherché.
Dans cet exemple le mot recherché se trouve dans la colonne [A] , tu modifieras la colonne

Dim img As String
Dim Fichier As String
Private Sub ComboBox1_Change()
On Error Resume Next
img = ComboBox1.Value
Fichier = ActiveWorkbook.Path & "" & img & ".jpg"
FindIt
End Sub

Private Sub FindIt()
  Dim oRange As Range
Dim vRow As Variant
  If img = "" Then Exit Sub
Feuil1.Activate
  Set oRange = Feuil1.Range("A:A")
'Find the full cell contents
  'vRow = Application.Match(nom, oRange, False)

  'Trouver dans une partie du contenu de la cellule
  vRow = Application.Match("*" & img & "*", oRange, False)

  If IsError(vRow) Then
     MsgBox "Non trouvé"
  Else
   Feuil1.Range("A" & vRow).Select
   ActiveCell.Offset(0, 1).Select
    ActiveSheet.Pictures.Insert(Fichier).Select
   End If
 End Sub


Cette recherche se fait sur une seule colonne dans la Feuille1

@+Le Pivert

gerardmireille · Answer

Bonsoir,
Encore merci pour ta nouvelle proposition mais cela me parait un peu compliqué pour ce que je veux faire. 
Par contre ton code du 1/11 Sub RechercheMot()
me semble le plus proche de l'aboutissement mais je me suis aperçu en déboguant que la Cellule sélectionnée après la ligne
Set MotTrouvé = Cells.Find(What:=Var)
n'est pas celle qui contient le mot "1ère Femme" mais toujours la même cellule quelque soit la position de celle contenant "1ère Femme" 'En l'occurence la 1ère cellule de la colonne de mon tableau de classement ("G5").
Je pense que cela devrait te mettre sur la voie.
Encore un peu de ta matière grise serait sympa pour que boucle ce projet.
Merci
Cordialement

cs_Le Pivert · Answer

J'ai fait 2 exemples de code. Je pense que le classeur "RechercheMot est plus interessant car il trouve le mot n'importe où sur la feuille et le mot n'a pas besoin d'être complet ni d'avoir la même casse.
Voici le site où se trouve le dossier
http://www.cijoint.fr/cjlink.php?file=cj201011/cij2PhhidD.zip
J'espère que cela te permettra de finir ton projet
@+ Le Pivert

Macro pour insérer une image

10 réponses

Votre réponse

Discussions similaires