OVH Cloud OVH Cloud

Recherche cellule sans rectangle

7 réponses
Avatar
garnote
Bonsoir, Bonsoir,

J'ai choisi l'option dessin "Aligner sur la grille"
et inséré un rectangle dans trois cellules
de la plage A1:B2.
En associant la macro suivante aux trois rectangles,
je peux récupérer les numéros de ligne et colonne
où se trouve le rectangle sur lequel je frappe :
Sub Ou_Es_Tu()
i = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
j = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
MsgBox i & " " & j
End Sub
Question :
Sachant que les rectangles peuvent changer de position dans la plage,
comment modifier la macro pour obtenir les numéros de ligne et colonne
de la cellule ne contenant pas de rectangle.
Je tourne en rond. Dure soirée couscous hier ;-)
Hic et Help !

Serge

7 réponses

Avatar
michdenis
Bonjour Garnote,

Comme tu as les coordonnées de la cellule du coin supérieur gauche
et et de la cellule du coin inférieur droit, tu devrais être capable de
déduire la plage de cellule qu'occupe le rectangle ....

Pour chacune des cellules de la plage
tu testes si l'intersection entre cette cellule et la plage qu'occupe le rectangle
est égale à Nothing

Je compte sur toi pour nous mettre ceci en code et nous faire voir
le résultat de ton devoir !!!

;-))


Salutations!



"garnote" a écrit dans le message de news:
Bonsoir, Bonsoir,

J'ai choisi l'option dessin "Aligner sur la grille"
et inséré un rectangle dans trois cellules
de la plage A1:B2.
En associant la macro suivante aux trois rectangles,
je peux récupérer les numéros de ligne et colonne
où se trouve le rectangle sur lequel je frappe :
Sub Ou_Es_Tu()
i = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
j = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
MsgBox i & " " & j
End Sub
Question :
Sachant que les rectangles peuvent changer de position dans la plage,
comment modifier la macro pour obtenir les numéros de ligne et colonne
de la cellule ne contenant pas de rectangle.
Je tourne en rond. Dure soirée couscous hier ;-)
Hic et Help !

Serge
Avatar
garnote
Bonjour michdenis,

Excellente suggestion que la tienne.
Le dossier progresse.
Un exemple avec 15 rectangles dans la plage A1:D4.
Ça fonctionne mais j'aimerais bien construire mon
Union sans avoir à écrire les x(i) un à un.
Comment faire une boucle là-dessus ?

Sub Cellule_Sans_Rectangle()
Dim x(1 To 16)
Dim tous As Range
For Each patente In ActiveSheet.Shapes
i = i + 1
Set x(i) = patente.TopLeftCell
Next patente
Set tous = Union(x(1), x(2), x(3), x(4), x(5), x(6), x(7), x(8), x(9),
x(10), x(11), x(12), x(13), x(14), x(15))
For m = 1 To 4
For n = 1 To 4
If Intersect(Cells(m, n), tous) Is Nothing Then
Cells(m, n).Select
Exit Sub
End If
Next n
Next m
End Sub

A+

Serge


"michdenis" a écrit dans le message de news:
%
Bonjour Garnote,

Comme tu as les coordonnées de la cellule du coin supérieur gauche
et et de la cellule du coin inférieur droit, tu devrais être capable de
déduire la plage de cellule qu'occupe le rectangle ....

Pour chacune des cellules de la plage
tu testes si l'intersection entre cette cellule et la plage qu'occupe le
rectangle
est égale à Nothing

Je compte sur toi pour nous mettre ceci en code et nous faire voir
le résultat de ton devoir !!!

;-))


Salutations!



"garnote" a écrit dans le message de news:

Bonsoir, Bonsoir,

J'ai choisi l'option dessin "Aligner sur la grille"
et inséré un rectangle dans trois cellules
de la plage A1:B2.
En associant la macro suivante aux trois rectangles,
je peux récupérer les numéros de ligne et colonne
où se trouve le rectangle sur lequel je frappe :
Sub Ou_Es_Tu()
i = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
j = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
MsgBox i & " " & j
End Sub
Question :
Sachant que les rectangles peuvent changer de position dans la plage,
comment modifier la macro pour obtenir les numéros de ligne et colonne
de la cellule ne contenant pas de rectangle.
Je tourne en rond. Dure soirée couscous hier ;-)
Hic et Help !

Serge








Avatar
bourby
bonsoir,

si je comprends bien ta question, la plage à considérer est toujours
carrée; mais on peut traiter un rectangle de la même manière.

On peut soit créer un tableau à 2 dimensions, image de la plage; soit
utiliser une autre plage quelque part.

On parcourt la liste des shapes (attention quand même si la feuille en
contient d'autres que les rectangles....), et on inscrit le n° de
chacune dans l'élément de tableau, ou dans la cellule
de coordonnées (.TopLeftCell.Row, .TopLeftCell.Column). Ensuite, il n'y
a plus qu'à chercher l'élément du tableau = 0, ou la cellule vide.

Cela convient-il?

Bourby

garnote wrote:
Bonsoir, Bonsoir,

J'ai choisi l'option dessin "Aligner sur la grille"
et inséré un rectangle dans trois cellules
de la plage A1:B2.
En associant la macro suivante aux trois rectangles,
je peux récupérer les numéros de ligne et colonne
où se trouve le rectangle sur lequel je frappe :
Sub Ou_Es_Tu()
i = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
j = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
MsgBox i & " " & j
End Sub
Question :
Sachant que les rectangles peuvent changer de position dans la plage,
comment modifier la macro pour obtenir les numéros de ligne et colonne
de la cellule ne contenant pas de rectangle.
Je tourne en rond. Dure soirée couscous hier ;-)
Hic et Help !

Serge







Avatar
michdenis
Essaie ceci si tu veux seulement les cellules qui n'ont pas
de "Shape"

'------------------------------------------
Sub Cellule_Sans_Rectangle()
Dim Rg As Range, Sh As Shape, R As Range

With Worksheets("Feuil2")
For Each Sh In ActiveSheet.Shapes
If Rg Is Nothing Then
Set Rg = .Range(Sh.TopLeftCell.Address & ":" & _
Sh.BottomRightCell.Address)
Else
Set Rg = Union(Rg, .Range(Sh.TopLeftCell.Address & _
":" & Sh.BottomRightCell.Address))
End If
Next
For Each c In .Range("A1:D4")
If Intersect(c, Rg) Is Nothing Then
If R Is Nothing Then
Set R = c
Else
Set R = Union(R, c)
End If
End If
Next
End With
R.Select
Set Rg = Nothing: Set Sh = Nothing: Set R = Nothing
End Sub
'------------------------------------------


Salutations!



"garnote" a écrit dans le message de news: OSai$
Bonjour michdenis,

Excellente suggestion que la tienne.
Le dossier progresse.
Un exemple avec 15 rectangles dans la plage A1:D4.
Ça fonctionne mais j'aimerais bien construire mon
Union sans avoir à écrire les x(i) un à un.
Comment faire une boucle là-dessus ?

Sub Cellule_Sans_Rectangle()
Dim x(1 To 16)
Dim tous As Range
For Each patente In ActiveSheet.Shapes
i = i + 1
Set x(i) = patente.TopLeftCell
Next patente
Set tous = Union(x(1), x(2), x(3), x(4), x(5), x(6), x(7), x(8), x(9),
x(10), x(11), x(12), x(13), x(14), x(15))
For m = 1 To 4
For n = 1 To 4
If Intersect(Cells(m, n), tous) Is Nothing Then
Cells(m, n).Select
Exit Sub
End If
Next n
Next m
End Sub

A+

Serge


"michdenis" a écrit dans le message de news:
%
Bonjour Garnote,

Comme tu as les coordonnées de la cellule du coin supérieur gauche
et et de la cellule du coin inférieur droit, tu devrais être capable de
déduire la plage de cellule qu'occupe le rectangle ....

Pour chacune des cellules de la plage
tu testes si l'intersection entre cette cellule et la plage qu'occupe le
rectangle
est égale à Nothing

Je compte sur toi pour nous mettre ceci en code et nous faire voir
le résultat de ton devoir !!!

;-))


Salutations!



"garnote" a écrit dans le message de news:

Bonsoir, Bonsoir,

J'ai choisi l'option dessin "Aligner sur la grille"
et inséré un rectangle dans trois cellules
de la plage A1:B2.
En associant la macro suivante aux trois rectangles,
je peux récupérer les numéros de ligne et colonne
où se trouve le rectangle sur lequel je frappe :
Sub Ou_Es_Tu()
i = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
j = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
MsgBox i & " " & j
End Sub
Question :
Sachant que les rectangles peuvent changer de position dans la plage,
comment modifier la macro pour obtenir les numéros de ligne et colonne
de la cellule ne contenant pas de rectangle.
Je tourne en rond. Dure soirée couscous hier ;-)
Hic et Help !

Serge








Avatar
michdenis
Un petit oubli pour la dernière ligne de code... au cas où toutes
les cellules contiennent au moins une Shape...

Remplacer : R.Select

Par :

If Not R Is Nothing Then
R.Select
End If


Salutations!



"michdenis" a écrit dans le message de news: OqQ%23%
Essaie ceci si tu veux seulement les cellules qui n'ont pas
de "Shape"

'------------------------------------------
Sub Cellule_Sans_Rectangle()
Dim Rg As Range, Sh As Shape, R As Range

With Worksheets("Feuil2")
For Each Sh In ActiveSheet.Shapes
If Rg Is Nothing Then
Set Rg = .Range(Sh.TopLeftCell.Address & ":" & _
Sh.BottomRightCell.Address)
Else
Set Rg = Union(Rg, .Range(Sh.TopLeftCell.Address & _
":" & Sh.BottomRightCell.Address))
End If
Next
For Each c In .Range("A1:D4")
If Intersect(c, Rg) Is Nothing Then
If R Is Nothing Then
Set R = c
Else
Set R = Union(R, c)
End If
End If
Next
End With
R.Select
Set Rg = Nothing: Set Sh = Nothing: Set R = Nothing
End Sub
'------------------------------------------


Salutations!



"garnote" a écrit dans le message de news: OSai$
Bonjour michdenis,

Excellente suggestion que la tienne.
Le dossier progresse.
Un exemple avec 15 rectangles dans la plage A1:D4.
Ça fonctionne mais j'aimerais bien construire mon
Union sans avoir à écrire les x(i) un à un.
Comment faire une boucle là-dessus ?

Sub Cellule_Sans_Rectangle()
Dim x(1 To 16)
Dim tous As Range
For Each patente In ActiveSheet.Shapes
i = i + 1
Set x(i) = patente.TopLeftCell
Next patente
Set tous = Union(x(1), x(2), x(3), x(4), x(5), x(6), x(7), x(8), x(9),
x(10), x(11), x(12), x(13), x(14), x(15))
For m = 1 To 4
For n = 1 To 4
If Intersect(Cells(m, n), tous) Is Nothing Then
Cells(m, n).Select
Exit Sub
End If
Next n
Next m
End Sub

A+

Serge


"michdenis" a écrit dans le message de news:
%
Bonjour Garnote,

Comme tu as les coordonnées de la cellule du coin supérieur gauche
et et de la cellule du coin inférieur droit, tu devrais être capable de
déduire la plage de cellule qu'occupe le rectangle ....

Pour chacune des cellules de la plage
tu testes si l'intersection entre cette cellule et la plage qu'occupe le
rectangle
est égale à Nothing

Je compte sur toi pour nous mettre ceci en code et nous faire voir
le résultat de ton devoir !!!

;-))


Salutations!



"garnote" a écrit dans le message de news:

Bonsoir, Bonsoir,

J'ai choisi l'option dessin "Aligner sur la grille"
et inséré un rectangle dans trois cellules
de la plage A1:B2.
En associant la macro suivante aux trois rectangles,
je peux récupérer les numéros de ligne et colonne
où se trouve le rectangle sur lequel je frappe :
Sub Ou_Es_Tu()
i = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
j = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
MsgBox i & " " & j
End Sub
Question :
Sachant que les rectangles peuvent changer de position dans la plage,
comment modifier la macro pour obtenir les numéros de ligne et colonne
de la cellule ne contenant pas de rectangle.
Je tourne en rond. Dure soirée couscous hier ;-)
Hic et Help !

Serge








Avatar
garnote
Salut Denis,

Merci pour ta suggestion. Voici ce que
j'avais trouvé. C'était mes premiers efforts
pour en arriver à macrotiser un petit jeu
offrant plus de 1000 milliards de situations
distinctes ;-) Merci aussi à Bourby.

Sub Trouver_La_Cellule_Sans_Rectangle()
'La plage de 16 cellules contenant
'mes quinze rectangles se nomme jeu.
Dim x(1 To 16)
Dim plage As Range, ici As Range
For Each patente In ActiveSheet.Shapes
i = i + 1
Set x(i) = patente.TopLeftCell
Next patente
Set plage = Union(x(1), x(2))
For j = 3 To 15
Set plage = Union(plage, x(j))
Next j
Set ici = [jeu]
For Each cellule In ici
k = k + 1
If Intersect(ici(k), plage) Is Nothing Then
ici(k).Select
Exit Sub
End If
Next cellule
End Sub

A+
Serge


"michdenis" a écrit dans le message de news:
OqQ%23%
Essaie ceci si tu veux seulement les cellules qui n'ont pas
de "Shape"

'------------------------------------------
Sub Cellule_Sans_Rectangle()
Dim Rg As Range, Sh As Shape, R As Range

With Worksheets("Feuil2")
For Each Sh In ActiveSheet.Shapes
If Rg Is Nothing Then
Set Rg = .Range(Sh.TopLeftCell.Address & ":" & _
Sh.BottomRightCell.Address)
Else
Set Rg = Union(Rg, .Range(Sh.TopLeftCell.Address & _
":" & Sh.BottomRightCell.Address))
End If
Next
For Each c In .Range("A1:D4")
If Intersect(c, Rg) Is Nothing Then
If R Is Nothing Then
Set R = c
Else
Set R = Union(R, c)
End If
End If
Next
End With
R.Select
Set Rg = Nothing: Set Sh = Nothing: Set R = Nothing
End Sub
'------------------------------------------


Salutations!



"garnote" a écrit dans le message de news:
OSai$
Bonjour michdenis,

Excellente suggestion que la tienne.
Le dossier progresse.
Un exemple avec 15 rectangles dans la plage A1:D4.
Ça fonctionne mais j'aimerais bien construire mon
Union sans avoir à écrire les x(i) un à un.
Comment faire une boucle là-dessus ?

Sub Cellule_Sans_Rectangle()
Dim x(1 To 16)
Dim tous As Range
For Each patente In ActiveSheet.Shapes
i = i + 1
Set x(i) = patente.TopLeftCell
Next patente
Set tous = Union(x(1), x(2), x(3), x(4), x(5), x(6), x(7), x(8), x(9),
x(10), x(11), x(12), x(13), x(14), x(15))
For m = 1 To 4
For n = 1 To 4
If Intersect(Cells(m, n), tous) Is Nothing Then
Cells(m, n).Select
Exit Sub
End If
Next n
Next m
End Sub

A+

Serge


"michdenis" a écrit dans le message de news:
%
Bonjour Garnote,

Comme tu as les coordonnées de la cellule du coin supérieur gauche
et et de la cellule du coin inférieur droit, tu devrais être capable de
déduire la plage de cellule qu'occupe le rectangle ....

Pour chacune des cellules de la plage
tu testes si l'intersection entre cette cellule et la plage qu'occupe le
rectangle
est égale à Nothing

Je compte sur toi pour nous mettre ceci en code et nous faire voir
le résultat de ton devoir !!!

;-))


Salutations!



"garnote" a écrit dans le message de news:

Bonsoir, Bonsoir,

J'ai choisi l'option dessin "Aligner sur la grille"
et inséré un rectangle dans trois cellules
de la plage A1:B2.
En associant la macro suivante aux trois rectangles,
je peux récupérer les numéros de ligne et colonne
où se trouve le rectangle sur lequel je frappe :
Sub Ou_Es_Tu()
i = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
j = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column
MsgBox i & " " & j
End Sub
Question :
Sachant que les rectangles peuvent changer de position dans la plage,
comment modifier la macro pour obtenir les numéros de ligne et colonne
de la cellule ne contenant pas de rectangle.
Je tourne en rond. Dure soirée couscous hier ;-)
Hic et Help !

Serge













Avatar
Modeste
Bonsour® Serge avec ferveur ;o))) vous nous disiez :

macrotiser un petit jeu offrant plus de 1000 milliards de situations
distinctes


quelques idées à reprendre là :
http://www.excelabo.net/moteurs/compteclic.php?nom=pe-taquin
du même acabit :
http://www.xl-logic.com/xl_files/games/mosaic.zip

--
;o)))
@+

Les news à la source !!!
news://news.microsoft.com/microsoft.public.fr.excel
et répondez OUI

n'oubliez pas les FAQ :http://www.excelabo.net
http://dj.joss.free.fr/faq.htm
http://www.faqoe.com http://faqword.free.fr