Copier une image suite à une condition

I

iosis

XLDnaute Nouveau
Bonjour,

je souhaite attribuer des images spécifiques suivant le résultat d'un calcul,

j'ai les 2 macros suivantes comme exemple mais je n'arrive pas à les faire fonctionner:

Sub copier_image_A()
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$C$2" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
End Sub

Function copier_A(C)

If C < 10 Then Application.Run ("copier_image_A")

End Function

la première fonctionne bien mais je n'arrive à la faire fonctionner avec une condition.

Merci de votre aide,
 
Trier par date Trier par votes
I

iosis

XLDnaute Nouveau
Re : Copier une image suite à une condition

je souhaite utiliser la fonction "copier_a" en utilisant à l'intérieur la macro "copier_image_A()"

je ne suis pas sur d'etre suffisament clair, n'ayant que peu de notion VBA.

merci
 
Vote positif 0 Vote négatif
I

iosis

XLDnaute Nouveau
Re : Copier une image suite à une condition

Le calcul de C se trouve dans une cellule d'excel et issue d'un calcul simple et je souhaite donc utiliser la fonction "copier_A" pour afficher une image suivant le résultat de C.

Merci !
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Copier une image suite à une condition

En supposant que "C" se trouve en A1, tu peux le faire sans fonction:

Sub copier_image_A()
If Range("A1").Value < 10 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$C$2" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
End If
End Sub

 
Vote positif 0 Vote négatif
I

iosis

XLDnaute Nouveau
Re : Copier une image suite à une condition

suite j'ai réussi à faire fonctionner la macro avec 2 renvois d'image différentes suivant le résultat en A1 suivant le principe ci-dessous :

Sub copier_image_A()
If Range("A1").Value < 10 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$2" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
Else
If 11 < Range("A1").Value < 20 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$3" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
End If
End If
End Sub

mais si je souhaite faire un troisième cas par exemple A1>21 suivant le même principe, cela ne fonctionne pas voir ci-dessous :

Sub copier_image_A()
If Range("A1").Value < 10 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$2" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
Else
If 11 < Range("A1").Value < 20 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$3" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
Else
If Range("A1").Value > 21 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$4" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
End If
End If
End If
End Sub


Je ne comprends pas tout...
 
Vote positif 0 Vote négatif
I

iosis

XLDnaute Nouveau
Re : Copier une image suite à une condition

Et voilà pour le plaisir des yeux ;)

suite j'ai réussi à faire fonctionner la macro avec 2 renvois d'image différentes suivant le résultat en A1 suivant le principe ci-dessous :

Sub copier_image_A()
If Range("A1").Value < 10 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$2" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
Else
If 11 < Range("A1").Value < 20 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$3" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
End If
End If
End Sub

mais si je souhaite faire un troisième cas par exemple A1>21 suivant le même principe, cela ne fonctionne pas voir ci-dessous :

Sub copier_image_A()
If Range("A1").Value < 10 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$2" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
Else
If 11 < Range("A1").Value < 20 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$3" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
Else
If Range("A1").Value > 21 Then
For Each image In ActiveSheet.DrawingObjects
If image.BottomRightCell.Address = "$B$4" Then
image.Select
Selection.Copy
[D2].Select
ActiveSheet.Paste
End If
Next
End If
End If
End If
End Sub


Je ne comprends pas tout...
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Copier une image suite à une condition

Re,

modifie comme ceci, ça devrait aller mieux.


Code: 
Sub copier_image_A()
If Range("A1").Value < 10 Then
    For Each image In ActiveSheet.DrawingObjects
        If image.BottomRightCell.Address = "$B$2" Then
            image.Select
            Selection.Copy
            [D2].Select
            ActiveSheet.Paste
        End If
    Next
ElseIf [B]Range("A1").Value >= 11 And Range("A1").Value <= 20[/B] Then
    For Each image In ActiveSheet.DrawingObjects
        If image.BottomRightCell.Address = "$B$3" Then
            image.Select
            Selection.Copy
            [D2].Select
            ActiveSheet.Paste
        End If
    Next
ElseIf Range("A1").Value > 21 Then
    For Each image In ActiveSheet.DrawingObjects
        If image.BottomRightCell.Address = "$B$4" Then
            image.Select
            Selection.Copy
            [D2].Select
            ActiveSheet.Paste
        End If
    Next
End If
End Sub

D'autre part, j'ai "ordonné" le code, plus facile à lire que d'avoir tout sur la même ligne.
 
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
Re : Copier une image suite à une condition

Ou bien en utilisant "Select Case", plus approprié:

Code: 
Sub copier_image_A()
[B]Select Case Range("A1").Value[/B]
[B]Case Is < 10[/B]
    For Each image In ActiveSheet.DrawingObjects
        If image.BottomRightCell.Address = "$B$2" Then
            image.Select
            Selection.Copy
            [D2].Select
            ActiveSheet.Paste
        End If
    Next
[B]Case 11 To 20[/B]
    For Each image In ActiveSheet.DrawingObjects
        If image.BottomRightCell.Address = "$B$3" Then
            image.Select
            Selection.Copy
            [D2].Select
            ActiveSheet.Paste
        End If
    Next
[B]Case Is > 20[/B]
    For Each image In ActiveSheet.DrawingObjects
        If image.BottomRightCell.Address = "$B$4" Then
            image.Select
            Selection.Copy
            [D2].Select
            ActiveSheet.Paste
        End If
    Next
[B]End Select[/B]
End Sub

Voilà.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Copier une image suite à une condition

Bonsoir à tous


Une petite question:

Y-a t-il quelque chose à espérer dans cette voie
Code: 
Sub copier_image_A()
Dim valeurs() As Variant
Dim adresses() As Variant
Dim i As Long
Dim j As Long
valeurs = Array(10, 11, 21)
adresses = Array("$B$2", "$B$3", "$B$4")
For j = 0 To UBound(valeurs)
If Range("A1").Value < valeurs(j) Then
For i = 0 To UBound(adresses)
    For Each image In ActiveSheet.DrawingObjects
        If image.BottomRightCell.Address = adresses(i) Then
            image.Select
            Selection.Copy
            [D2].Select
            ActiveSheet.Paste
        End If
    Next
Next i
End If
Next j
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

Jouxte
  • Question
XL 2021 coller une image interne au classeur
2 3
Réponses
33
Affichages
840
Jouxte
Jouxte
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
547
crocrocro
C
T
  • Résolu(e)
Microsoft 365 Insérer une image DANS une cellule
Réponses
12
Affichages
359
Thomi
T
jeff1494
  • Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
964
AtTheOne
AtTheOne
M
  • Résolu(e)
XL 2016 comment créer une Barre de défilement ou faire simplement défiler son texte ?
2
Réponses
25
Affichages
760
melltel
M
D
  • Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
565
AtTheOne
AtTheOne
T
  • Question
Microsoft 365 probleme passage paramètre dans une fonction
Réponses
8
Affichages
368
Phil69970
Phil69970
L
  • Question
Microsoft 365 Macro Insertion image dans cellule
Réponses
3
Affichages
535
Dranreb
Dranreb
L
  • Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
247
AtTheOne
AtTheOne
A
  • Question
XL 2016 Adapter une image à une cellule
2
Réponses
16
Affichages
2 K
Dudu2
Dudu2

Membres actuellement en ligne

1 membres et 70 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
313 889
Messages
2 103 295
Membres
108 579
dernier inscrit
Henschel