Afficher et supprimer des images en VBA avec un menu déroulant

Phiphi27700

XLDnaute Nouveau
Problème VBA sous EXCEL 2010 je joins mon petit fichier.
Voilà j'ai dans le fichier joint dans la ligne surligné en jaune des menus déroulants qui lors ce que je choisis un numéro il affiche l'image ainsi que le type et la référence dans des cellules.
Ce que je voudrai obtenir dans un premier temps c'est:
Je sélectionne le premier menu et je choisis 104 l'image s'affiche bien mais si je veux changer en une autre référence 011 l'ancienne image ne s'efface pas :mad:. Il faudrait qu'elle s'efface!
En plus dans cette deuxième sélection elle fusionne avec les cellules de gauche.
Cette fusion des cellules est présente que lors ce que je sélectionne deux repères identique.
La aussi quand deux repères sont cote cote et que je change l'un deux il faudrait que les cellules redeviennent unique.
Ou si je supprime une image toujours la dernière des deux fusionnés elle retire les cellules fusionnées
je n'arrive pas centrer les images au milieu de la cellule.
A l'avance merci
Bonne soirée à tous
 

Pièces jointes

  • Liste de raccords ind.xlsm
    84 KB · Affichages: 136

PMO2

XLDnaute Accro
Re : Afficher et supprimer des images en VBA avec un menu déroulant

Bonjour,

Pour ce qui concerne
Je sélectionne le premier menu et je choisis 104 l'image s'affiche bien mais si je veux changer en une autre référence 011 l'ancienne image ne s'efface pas . Il faudrait qu'elle s'efface!

essayez votre code modifié (les ajouts sont signalés par de ///)
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

'///ajout
Dim PIC As Excel.Picture
'///


Application.DisplayAlerts = False
Dim Plage As Range, Intersection As Range
Set Plage = Range("B5:Z5")
Set Intersection = Intersect(Target, Plage)

If Not (Intersection Is Nothing) Then

'-----------------------------------------------------------------

   If Intersection.Value <> "" Then
      For repere = 2 To 100
          If Sheets(2).Cells(4, repere).Value = Intersection.Value Then

'///ajout
For Each PIC In ActiveSheet.Pictures
  If PIC.TopLeftCell.Address = Target.Offset(1, 0).Address Then
    PIC.Delete
    Exit For
  End If
Next PIC
'///

              Sheets(2).Shapes("_" & Target).Copy
              Target.Offset(1, 0).Select
              ActiveSheet.Paste
              Selection.ShapeRange.Left = ActiveCell.Left + ActiveCell.Width / 2 - Selection.ShapeRange.Width / 2
              Target.Offset(-3, 0) = Sheets(2).Cells(1, repere).Value
              Target.Offset(2, 0) = Sheets(2).Cells(6, repere).Value
     
     'FUSION D'UN MEME TYPE POUR LES CELLULES CONTINGUES
      If Target.Offset(-3, 0) = Target.Offset(-3, -1) Then
          Range("A1:A1") = Target.Offset(-3, 0)
          Range(Target.Offset(-3, 0), Target.Offset(-3, -1)).Merge
      End If
      
      If Target.Offset(-3, 0) = Range("A1:A1") Then
          Range(Target.Offset(-3, 0), Target.Offset(-3, -1)).Merge
      End If
  End If
Next repere
End If
Else
Exit Sub
End If
Range("B5:B5").Activate
Application.DisplayAlerts = True
End Sub
 

Phiphi27700

XLDnaute Nouveau
Re : Afficher et supprimer des images en VBA avec un menu déroulant

Bonjour,
Merci c'est cela mais je souhaiterai que lors ce que deux références cote cote qui sont identiques et que je change une des deux cela me retire les cellules fusionnées et que les désignations correspondent a l'image.
J'espère que mon explication est assez claire
Merci
 

Phiphi27700

XLDnaute Nouveau
Re : Afficher et supprimer des images en VBA avec un menu déroulant

Bonsoir
Merci c'est cela mais je souhaiterai que lors ce que deux références cote cote qui sont identiques et que je change une des deux cela me retire les cellules fusionnées et que les désignations correspondent a l'image.
J'espère que mon explication est assez claire
Merci
 

Discussions similaires

Statistiques des forums

Discussions
312 329
Messages
2 087 329
Membres
103 517
dernier inscrit
hbenaoun63