Je suis nouveau dans le monde de la programmation excel, et je me retrouve face à un problème que je n'arrive pas à résoudre.
Je suis entrain de créer une macro dans laquelle j'intègre un code permettant d'afficher une photo dans une case, ainsi qu'un code permettant de la supprimer. Ce code apparait à différents endroits dans la macro.
With Worksheets("P9 chaleur tournante")
For Each Sh In .Shapes
If Not Application.Intersect(Sh.TopLeftCell, .Range("C45")) Is Nothing Then
Sh.Delete
End If
Next Sh
End With
Voici mon problème : Sur le PC que j'ai utilisé pour créer la macro, ce code fonctionne très bien. Seulement, lorsque je souhaite utiliser cette macro sur un autre PC, le code d'affichage fonctionne pour toutes les images que je souhaite afficher, mais le code pour supprimer les images ne fonctionne pas pour toutes les images. C'est à dire que certaines images sont effacées, et d'autres non. J'utilise pourtant le même code pour chaque image.
J'ai déjà vérifié le niveau de sécurité des macros sur le PC, ainsi que les références. Tout est identique sur les deux PC.
Du coup je sèche un peu. Est-ce que cela peut provenir du fait que le PC que j'ai utilisé pour créer la macro soit plus puissant que celui sur lequel j'ai testé la macro ?
Le problème est lié je pense au fait qu'à l'enregistrement du fichier et à l'ouverture sur un autre poste, l'image n'est plus exactement sur le pixel de la cellule C45, car la résolution d'écran change. Du coup le .TopLeftCell n'est plus sur la cellule C45. Pour régler ceci, décale d'un ou 2 pixels ainsi à la création :
VB:
With Worksheets("P9 chaleur tournante").Pictures.Insert("F:\MF\Montage Fours\CheckList\media\AttentionAmerique.jpg")
.Left = Range("C45").Left + 2
.Top = Range("C45").Top + 2
.Width = Range("C45").Width - 4
.Height = Range("C45").Height- 4
End With
Sinon, tu peux aussi tester un code de ce type qui supprime les objets de la sélection:
Code:
Sub Supprime_Objets()
Dim ObjetTraite As Object ' declaration variables
Dim Boucle As Long
Dim Plage As Range
Set Plage = Selection ' on donne la selection comme plage
For Each ObjetTraite In ActiveSheet.DrawingObjects ' pour tous les objets
For Boucle = Plage.Cells.Count To 1 Step -1 ' Dans chaque cellule de la selection
If Plage.Cells(Boucle).Address = ObjetTraite.TopLeftCell.Address Then ' si les adresses sont identique $a$2=$a$2
ObjetTraite.Delete ' on efface l'objet
Exit For ' on sort de la boucle 1 seul objet par cellule
End If
Next
Next
Set Plage = Nothing
End Sub
Merci beaucoup pour votre aide.
Je vais tester les solutions que vous m'avez proposées. Je vous tiens au courant !
EDIT : Merci Softmama, j'ai réussi à bricoler quelque chose qui fonctionne en suivant ton idée
Merci également à toi MJ13. Ton code est encore un peu trop compliqué pour mon niveau. Ce qui me montre que j'ai encore beaucoup de choses à apprendre !