XL 2019 Vérifier la position du rectangle et créer une action

[bennp]

Bonjour,

je souhaiterais vérifier si le rectangle est bien placé entre D8 et I28 (ou on pourrait aussi vérifier si le bord haut gauche du rectangle est bien situé entre D10 et F15).

Si c'est le cas, mettre "OK" en A1, sinon mettre "PAS OK" en A1.

Merci d'avance pour votre aide.

ps: en VBA svp

 

[Compte Supprimé 979]

Bonjour Bennp

On peut connaitre la cellule de gauche contenant la forme mais pas celle de droite

Sub Verif()
  Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    MsgBox "Cellule de gauche en haut de la forme " & Shp.TopLeftCell.Address(0, 0)
  Next Shp
End Sub

A moins de faire une moulinette avec un calcul tarabiscoté

@+

 

[bennp]

Super Merci,
j'ai pu vérifier si la case trouvée était bien dans mon cadre recherché :

Sub Verif()
  Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    'MsgBox "Cellule de gauche en haut de la forme " & Shp.TopLeftCell.Address(0, 0)
    Range("A2") = Shp.TopLeftCell.Address(0, 0)
    
  
  Next Shp
If Range("A2").Value = "D8" Or Range("A2").Value = "D9" Or Range("A2").Value = "D10" Or Range("A2").Value = "D11" Or Range("A2").Value = "D12" Or Range("A2").Value = "E8" Or Range("A2").Value = "E9" Or Range("A2").Value = "E10" Or Range("A2").Value = "E11" Or Range("A2").Value = "D12" Then
Range("A1") = "ok"

Else

Range("A1") = "pas ok"

End If

End Sub

Est ce qu'on pourrait améliorer le code en demandant directement si la valeur de la cellulle est entre D8 et E12 sans ajouter tous les OR ?

 

[job75]

Bonjour,

On peut connaitre la cellule de gauche contenant la forme mais pas celle de droite

Bien sûr que si Bruno => Shp.BottomRightCell.Address(0, 0)

A+

 

[Compte Supprimé 979]

Bonjour,

Bien sûr que si Bruno => Shp.BottomRightCell.Address(0, 0)

A+

Salut Job75
Ca existe quel ignare je fais... je dormirais moins bête ce soir

 

[job75]

Voyez le fichier joint et cette macro :

Sub Test()
With ActiveSheet.Shapes("Rectangle 1")
    [A1] = IIf(Intersect([B8:E16], .TopLeftCell) Is Nothing Or Intersect([B8:E16], .BottomRightCell) Is Nothing, "pas OK", "OK")
End With
End Sub

 

[Compte Supprimé 979]

Re,

Sinon on peut faire aussi

Sub Verif()
  Dim Shp As Shape, Plg As Range
  Set Shp =  ActiveSheet.Shapes("Rectangle 1")
  Set Plg = Range(Shp.TopLeftCell.Address & ":" & Shp.BottomRightCell.Address)
  Range("A" & Rows.Count).End(xlUp).Value = Not Intersect(Plg, Range("D8:E12")) Is Nothing
End Sub

@+

 

[bennp]

Merci à tous pour votre jolie combat Mission accomplie !!