Bonjour,
J'ai un souci depuis un long moment que je n'arrive pas à résoudre malgré la quantité de sujet que j'ai consulté sur le net sur cette erreur.
J'espère que vous pourrez m'aider, je partage le code (j'ai supprimé ce qui n'était pas nécessaire pour que le code soit lisible).
Le code ajoute/supprime des logos en fonction des symboles insérés par les utilisateurs si ceux-ci existent.
Ces logos sont récupérés via une requête et stockés sous forme d'URL dans des feuilles.
J'ai essayé avec les 2 fonctions "Logo" et "SupprimerImage" que vous retrouverez ci-dessous. Le résultat est le même, cependant j'ai aléatoirement l'erreur 1004 : Erreur définie par l'application ou par l'objet dans la fonction "SupprimerImage" (j'ai tagué la ligne dans le code) et ce peu importe si on est dans le "cas 1" ou le "cas 2" (tagué dans le code).
PS: J'ai remarqué que lorsque l'erreur survient, pour la bypass, il me suffit d'effacer le symbole, allez au débogage, réinitialiser, sauvegarder le doc, le réouvrir et réinsérer le symbole. Après je n'ai plus d'erreur pendant un moment, je peut donc changer le symbole, le supprimer, les logos fonctionnent correctement en conséquences.
Merci d'avance pour votre aide.
J'ai un souci depuis un long moment que je n'arrive pas à résoudre malgré la quantité de sujet que j'ai consulté sur le net sur cette erreur.
J'espère que vous pourrez m'aider, je partage le code (j'ai supprimé ce qui n'était pas nécessaire pour que le code soit lisible).
Le code ajoute/supprime des logos en fonction des symboles insérés par les utilisateurs si ceux-ci existent.
Ces logos sont récupérés via une requête et stockés sous forme d'URL dans des feuilles.
J'ai essayé avec les 2 fonctions "Logo" et "SupprimerImage" que vous retrouverez ci-dessous. Le résultat est le même, cependant j'ai aléatoirement l'erreur 1004 : Erreur définie par l'application ou par l'objet dans la fonction "SupprimerImage" (j'ai tagué la ligne dans le code) et ce peu importe si on est dans le "cas 1" ou le "cas 2" (tagué dans le code).
PS: J'ai remarqué que lorsque l'erreur survient, pour la bypass, il me suffit d'effacer le symbole, allez au débogage, réinitialiser, sauvegarder le doc, le réouvrir et réinsérer le symbole. Après je n'ai plus d'erreur pendant un moment, je peut donc changer le symbole, le supprimer, les logos fonctionnent correctement en conséquences.
Merci d'avance pour votre aide.
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
If Target.Count > 1 Then
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Exit Sub
End If
Select Case Target.Column
Case Is = 3 'Colonne Symbole
If Target <> "" Then 'Cas 1 : Si le symbole inséré est non vide
Target = UCase(Target)
Call BDD_Images(Target)
Else: 'Cas 2 : Si le symbole est vide
Call SupprimerImage(Target.Offset(0, -2))
End If
End Select
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
'Function SupprimerImage(imgPos As Range)
' Dim Image As Object
' For Each Image In Worksheets("Transactions").Shapes
' If Image.TopLeftCell.Address = imgPos.Address Then
' Image.Delete
' Exit Function
' End If
' Next Image
'End Function
Function SupprimerImage(imgPos As Range)
Dim Image As Object
For Each Image In Worksheets("Transactions").Shapes
If Not Intersect(Image.TopLeftCell, imgPos) Is Nothing Then ' Erreur 1004 : Erreur définie par l'application ou par l'objet
Image.Delete
End If
Next Image
End Function
'Function Logo(img As Range)
' With ActiveSheet.Pictures.Insert(img.Value)
' .ShapeRange.LockAspectRatio = msoFalse
' .Width = img.Width - 10
' .Height = img.Height - 3
' .Top = Rows(img.Row).Top + 2
' .Left = Columns(img.Column).Left + 5
' .Placement = xlMoveAndSize
' .Locked = True
' End With
' img.Value = "" 'On efface l'url pour ne garder que l'image
'End Function
Function Logo(img As Range)
Worksheets("Transactions").Shapes.AddPicture img.Value, msoTrue, msoTrue, Columns(img.Column).Left + 5, Rows(img.Row).Top + 2, img.Width - 10, img.Height - 3
img.Value = "" 'On efface l'url pour ne garder que l'image
End Function
Function BDD_Images(Compare As Range)
Dim PosLigne As Range
Set PosLigne = Compare.Offset(0, -2)
Call SupprimerImage(PosLigne)
If Compare = "EUR" Then
PosLigne = "https://seeklogo.com/images/E/Euro-logo-6333317E36-seeklogo.com.png"
Call Logo(PosLigne)
Exit Function
ElseIf Compare = "USD" Then
PosLigne = "https://em-content.zobj.net/source/microsoft-teams/337/heavy-dollar-sign_1f4b2.png"
Call Logo(PosLigne)
Exit Function
End If
Dim Val(40) As Range, i As Integer, Resultat As String
For i = 1 To 40
Set Val(i) = Worksheets("API_CG_" & i).Range("C2:C251").Find(Compare, lookat:=xlWhole) 'Recherche dans les tableaux API_CG_1 à 40
If Not Val(i) Is Nothing Then 'Si on retrouve le symbole contenu dans la variable "Compare"
PosLigne = Val(i).Offset(0, 2) 'On enregistre l'url de l'image dans la variable "PosLigne"
Resultat = Compare 'On bloque le symbole retrouvé dans la variable "Resultat"
Call Logo(PosLigne)
Exit Function 'On arrête ici pour ne prendre que le premier symbole et ainsi éviter les doublons
End If
Next i
If Resultat <> Compare Then
Set Val(0) = Worksheets("API_CMC").Range("C2:C10001").Find(Compare, lookat:=xlWhole) 'Si on ne retrouve pas le symbole dans l'API CG, on recherche dans l'API CMC.
If Not Val(0) Is Nothing Then 'Si on retrouve le symbole contenu dans la variable "Compare"
Resultat = Compare 'On bloque le symbole retrouvé dans la variable "Resultat"
Else: Compare = "-" 'Si le symbole est introuvable, on retourne "-" dans la case Symbole pour la mise en forme conditionnelle
End If
PosLigne = "https://cdn.icon-icons.com/icons2/317/PNG/512/sign-error-icon_34362.png"
Call Logo(PosLigne)
End If
End Function
Dernière édition:
