Macro pour insérer une image

Signaler
Messages postés
29
Date d'inscription
vendredi 16 mai 2008
Statut
Membre
Dernière intervention
15 mars 2014
-
Messages postés
7275
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 février 2021
-
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

10 réponses

Messages postés
7275
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 février 2021
120
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
Messages postés
29
Date d'inscription
vendredi 16 mai 2008
Statut
Membre
Dernière intervention
15 mars 2014

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
Messages postés
7275
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 février 2021
120
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
Messages postés
7275
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 février 2021
120
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
Messages postés
29
Date d'inscription
vendredi 16 mai 2008
Statut
Membre
Dernière intervention
15 mars 2014

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
Messages postés
7275
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 février 2021
120
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
Messages postés
29
Date d'inscription
vendredi 16 mai 2008
Statut
Membre
Dernière intervention
15 mars 2014

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
Messages postés
7275
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 février 2021
120
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
Messages postés
29
Date d'inscription
vendredi 16 mai 2008
Statut
Membre
Dernière intervention
15 mars 2014

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
Messages postés
7275
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 février 2021
120
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