Microsoft 365 Importation d'une cellule

Chris Linefield · 22 Août 2022

Bonjour tout le monde,

je voulais savoir s'il était possible d'importer l'image d'une cellule excel dans une autre, en fonction d'une condition vraie ou fausse ?
J'ai une petite image dans l'une de mes cellules sur une autre feuille, et si la condition est vraie, je récupère le contenu de la cellule ?

Merci à vous !

Deadpool_CC · 22 Août 2022

Chris Linefield à dit:
d'importer l'image d'une cellule excel dans une autre, en fonction d'une condition vraie ou fausse ?

Bonjour,
j'ai un peu e mal à voir le besoin et donc répondre ...
un fichier d'exemple ? et nous expliquer la/les conditions et le résultat attendu dans quelle cellule
avec cela on pourra mieux répondre sans avoir à sortir notre boule de Cristal

Chris Linefield · 23 Août 2022

Bonjour @Deadpool_CC
Désolé pour la réponse tardive, je cherche à faire en sorte d'éviter d'avoir 100 IF pour ma requête, je m'explique. J'ai une centaine de ligne, et j'aimerais avoir une fonction qui permet de check si la colonne "Niveau de risque W33" est égale à une valeur en String. Si c'est vrai, il importe une image dans la colonne "Niveau risque" à la ligne correspondante, si c'est faux, il continue l'exécution de la fonction jusqu'à trouver une correspondance.
Voici mon code pour une ligne, je pensais à une boucle FOR mais j'ai un doute sur la formulation de celle-ci.

VB:

Sub importimage()
 
Dim Shp As Shape
Dim Fichier As String
Dim Cell As Range
Dim F1 As Worksheet, F2 As Worksheet

Set F1 = Worksheets("Winged Surecan")
Set F2 = Worksheets("Statut")

If F1.Range("H5").Value = "Completely finished & implemented" Then
Fichier = "IMAGE"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)
ElseIf F1.Range("H5").Value = "Technical documentation finished" Then
Fichier = "IMAGE"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)
ElseIf F1.Range("H5").Value = "Low Probability not to meet timeline M4" Then
Fichier = "IMAGE"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)
ElseIf F1.Range("H5").Value = "Medium probability not to meet timeline M4" Then
Fichier = "IMAGE"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)
ElseIf F1.Range("H5").Value = "High probability not to meet timeline M4" Then
Fichier = "IMAGE"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)
ElseIf F1.Range("H5").Value = "Timeline M4 overdue (Delayed)" Then
Fichier = "IMAGE"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)
ElseIf F1.Range("H5").Value = "Not started / paused" Then
Fichier = "IMAGE"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)
ElseIf F1.Range("H5").Value = "Phase out" Then
Fichier = "IMAGE"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)
End If
End Sub

Merci de ton aide en tout cas !

Deadpool_CC · 23 Août 2022

Bonjour,
plutot que la sub ... le fichier exemple serait mieux pour pouvoir répondre correctement

après c'est une image par ligne si tu as beaucoup de ligne le fichier peut vite s'alourdir. image est vraiement la meilleur représentation ?
dans l'attente du fichier excel exemple (et sonnées nominative anonymiser si necessaire)

Phil69970 · 23 Août 2022

Bonjour @Chris Linefield , @Deadpool_CC

Comme la si bien dit @Deadpool_CC un fichier est beaucoup mieux qu'une image !

Je te propose (non testé car pas de fichier !!!)

VB:

Sub importimage()
 
Dim Shp As Shape
Dim Fichier As String
Dim Cell As Range
Dim F1 As Worksheet, F2 As Worksheet
Dim MaValeur As String

Set F1 = Worksheets("Winged Surecan")
Set F2 = Worksheets("Statut")

MaValeur = F1.Range("H5").Value

Select Case MaValeur
Case "Completely finished & implemented", "Technical documentation finished", "Low Probability not to meet timeline M4", _
    "Medium probability not to meet timeline M4", "High probability not to meet timeline M4", "Timeline M4 overdue (Delayed)", _
    "Not started / paused", "Phase out"
    Fichier = "IMAGE"
    Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)

Case Else
    MsgBox "Valeur non trouvé"

End Select

End Sub

Sans fichier je n'irais pas plus loin....

@Phil69970

Chris Linefield · 23 Août 2022

Phil69970 à dit:

Bonjour @Chris Linefield , @Deadpool_CC

Comme la si bien dit @Deadpool_CC un fichier est beaucoup mieux qu'une image !

Je te propose (non testé car pas de fichier !!!)

VB:

Sub importimage()
 
Dim Shp As Shape
Dim Fichier As String
Dim Cell As Range
Dim F1 As Worksheet, F2 As Worksheet
Dim MaValeur As String

Set F1 = Worksheets("Winged Surecan")
Set F2 = Worksheets("Statut")

MaValeur = F1.Range("H5").Value

Select Case MaValeur
Case "Completely finished & implemented", "Technical documentation finished", "Low Probability not to meet timeline M4", _
    "Medium probability not to meet timeline M4", "High probability not to meet timeline M4", "Timeline M4 overdue (Delayed)", _
    "Not started / paused", "Phase out"
    Fichier = "IMAGE"
    Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I5").Left + (Range("I5").Width - 41), Range("I5").Top + (Range("I5").Height - 17), 17, 19)

Case Else
    MsgBox "Valeur non trouvé"

End Select

End Sub

Sans fichier je n'irais pas plus loin....

@Phil69970

Voici le fichier en question.
Le but étant que la valeur comparé (I5 jusqu'à I82) compare son contenu avec chaque champ (
Completely finished & implemented", "Technical documentation finished", "Low Probability not to meet timeline M4", _
"Medium probability not to meet timeline M4", "High probability not to meet timeline M4", "Timeline M4 overdue (Delayed)", _
"Not started / paused", "Phase out") et, qu'en fonction affiche une image que j'ai sur le PC. Chaque champ correspond à une image et le script doit comparé l'ensemble des cellules.

Je ne sais pas si j'ai été assez clair ^^" N'hésitez pas si besoin ! et Merci pour l'aide @Phil69970

Chris Linefield · 23 Août 2022

C'est mieux avec le fichier ^^"

Phil69970 · 23 Août 2022

@Chris Linefield

Si j'ai bien vu il manque le code VBA dans le fichier ......

@Phil69970

Chris Linefield · 23 Août 2022

@Phil69970
En effet, j'ai fait une boulette. Voici le fichier avec le code VBA

Chris Linefield · 23 Août 2022

Solution trouvée !
La voici

VB:

Sub importimage()
 
Dim Shp As Shape
Dim Fichier As String
Dim Cell As Range
Dim Cellule As Integer
Dim Resultat As Integer
Dim F1 As Worksheet, F2 As Worksheet

Set F1 = Worksheets("Winged Surecan")
Set F2 = Worksheets("Statut")

Cellule = 5
Resultat = 5

Do While Cells(Cellule, 8).Value <> ""
If Cells(Cellule, 8).Value = "Completely finished & implemented" Then
Fichier = "IMG"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I" & Resultat).Left + (Range("I" & Resultat).Width - 41), Range("I" & Resultat).Top + (Range("I" & Resultat).Height - 17), 17, 19)
Cellule = Cellule + 1
Resultat = Resultat + 1
ElseIf Cells(Cellule, 8).Value = "Technical documentation finished" Then
Fichier = "IMG"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I" & Resultat).Left + (Range("I" & Resultat).Width - 41), Range("I" & Resultat).Top + (Range("I" & Resultat).Height - 17), 17, 19)
Cellule = Cellule + 1
Resultat = Resultat + 1
ElseIf Cells(Cellule, 8).Value = "Low Probability not to meet timeline M4" Then
Fichier = "IMG"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I" & Resultat).Left + (Range("I" & Resultat).Width - 41), Range("I" & Resultat).Top + (Range("I" & Resultat).Height - 17), 17, 19)
Cellule = Cellule + 1
Resultat = Resultat + 1
ElseIf Cells(Cellule, 8).Value = "Medium probability not to meet timeline M4" Then
Fichier = "IMG"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I" & Resultat).Left + (Range("I" & Resultat).Width - 41), Range("I" & Resultat).Top + (Range("I" & Resultat).Height - 17), 17, 19)
Cellule = Cellule + 1
Resultat = Resultat + 1
ElseIf Cells(Cellule, 8).Value = "High probability not to meet timeline M4" Then
Fichier = "IMG"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I" & Resultat).Left + (Range("I" & Resultat).Width - 41), Range("I" & Resultat).Top + (Range("I" & Resultat).Height - 17), 17, 19)
Cellule = Cellule + 1
Resultat = Resultat + 1
ElseIf Cells(Cellule, 8).Value = "Timeline M4 overdue (Delayed)" Then
Fichier = "IMG"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I" & Resultat).Left + (Range("I" & Resultat).Width - 41), Range("I" & Resultat).Top + (Range("I" & Resultat).Height - 17), 17, 19)
Cellule = Cellule + 1
Resultat = Resultat + 1
ElseIf Cells(Cellule, 8).Value = "Not started / paused" Then
Fichier = "IMG"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I" & Resultat).Left + (Range("I" & Resultat).Width - 41), Range("I" & Resultat).Top + (Range("I" & Resultat).Height - 17), 17, 19)
Cellule = Cellule + 1
Resultat = Resultat + 1
ElseIf Cells(Cellule, 8).Value = "Phase out" Then
Fichier = "IMG"
Set Shp = Worksheets("Winged Surecan").Shapes.AddPicture(Fichier, msoFalse, msoCTrue, Range("I" & Resultat).Left + (Range("I" & Resultat).Width - 41), Range("I" & Resultat).Top + (Range("I" & Resultat).Height - 17), 17, 19)
Cellule = Cellule + 1
Resultat = Resultat + 1
Else
F1.Range(H100) = ""
End If
Loop
End Sub

Chris Linefield · 23 Août 2022

@Phil69970 , @Deadpool_CC

J'ai une dernière question pour vous… Je suis désolé.
Il y aura une possibilité pour que les images s'auto redimensionne dans la cellule où elle apparait ?

Phil69970 · 23 Août 2022

@Chris Linefield

Vu ton code je doute qu'il fonctionne totalement tu as au minimum 1 erreur et chez moi ton code ne fonctionne pas du tout .

1 erreur ici :

Chris Linefield à dit:
F1.Range(H100) = ""

Tu devrais mettre :

Option Explicit

==> au début de ton code VBA cela te signalerais quelques erreurs et t'obligerais à déclarer tes variables

Peux tu joindre ton fichier

Merci de ton retour

@Phil69970

Phil69970 · 23 Août 2022

@Chris Linefield

Je te propose ce fichier
*L'image est copié dans la colonne D mais on peux facilement copier l'image dans une autre colonne.
*Une pause de 1 s est faite toutes les 10 copies pour laisser le temps à l'ordi de vider le presse papier

(Le temps est paramétrable et/ou supprimable)

Merci de ton retour

@Phil69970

Chris Linefield · 24 Août 2022

@Phil69970
Merci pour ton retour Phil !
Tout fonctionne vraiment bien ! J'ai juste une petite question, est-ce qu'il y a possibilité que l'image s'auto redimensionne en fonction de la cellule dans laquelle elle apparait ?

Deadpool_CC · 24 Août 2022

Bonjour,
a ma connaissance par d'auto dimensionnement lors de l'insertion. il va falloir fixer toi même, dans le code, la taille de l'image après insertion.

Microsoft 365 Importation d'une cellule

XLDnaute Junior

XLDnaute Accro

XLDnaute Junior

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Accro

Discussions similaires

Partager cette page

Statistiques des forums