Re : Nommer une Image par VBA avec recupération du nom dans une cellule
salut Martial
Pour la suite je souhaites bien copié dans RécapitulatifParcours d'où le With Feuil4
En effet j'ai des erreurs dans le code qui me semblait bon au regard de la transposition mais tjs des surprises:
**** Partie permettant de copier l'image JPG dans la Feuil4 ****
'Attribution d'une valeur à la variable Col, détermine dans
'quelle colonne on va copier l'image dans la Feuil4
Col = IIf(Lieu = "Robin", 2, 2) ' copie obligatoire sur la colonne 2 peu importe la condition d'où le , 2, 2
'Recherche la ligne de copie
Lig = Application.Match(Parcours2, Feuil4.Columns(1), 0) 'Parcours2 est le nom réel du parcours ( Du Type LieuAParcoursAA),acquis par une formule remplacée (Lieu1Parcours00 pour Robin; Lieu2Parcours00 pour Etcheberry) et présente dans la cellule K2; mon souhait serait également que si la cellule J9 n'est pas remplie un message apparaise afin de demander de la remplir (cellule comportant le numéro du parcours)
La suite me semble bonne
'Détermination du nom de l'image
Image = Lieu & " " & Fichier
'Avec la Feuil4
With Feuil4
'Vérifie si l'image existe dans Feuil4
For Each x In .Shapes
'Si elle existe
If x.Name = Image Then
'On demande si l'on souhaite la supprimer ?
If MsgBox("Voulez-vous remplacer la Parcours N°" & Parcours & "?", vbYesNo, "Remplacement") = vbYes Then
'si réponse OUI, on supprime l'image puis on sort de la boucle
.Shapes(Image).Delete
'On sort de la boucle pour suivre
Exit For
'Si la réponse est NON
Else
'On sort da la macro puisque l'on ne veut pas la remplacer.
Exit Sub
End If
End If
'On continue avec l'image suivante
Next x
'Détermination de c pour définir où copier
Set c = .Cells(Lig, Col)
'Insertion du fichier avec renommage de l'image dans la Feuil4
.Pictures.Insert(ChemFichier).Name = Image
'Modifie la hauteur de l'image, rajouter *2 :égale à 2 fois la hauteur de la cellule, car cellule fusionnée
.Shapes(Image).Height = c.Height * 0.9 'image à 90%
'Positionne à partir de la gauche l'image par rapport à la cellule C.Left Ici centrer:
.Shapes(Image).Left = c.Left + (c.Width * 0.05)
'Idem pour le positionnement en hauteur C.Top; Ici centrer:
.Shapes(Image).Top = c.Top + (c.Height * 0.05)
'Permet de garder les propotions de l'image, puisque ci-dessus nous n'avons modifié que la hauteur
.Shapes(Image).LockAspectRatio = msoTrue
End With
End Sub