Compter le nombre de "Shapes" dans une plage de cellules

**tiktak28** · 29/11/2012, 17h06

Bonjour,

J'aimerai pouvoir compter le nombre de "shapes" (zone de texte dans mon cas) dans une plage de cellule donnée et reporter le résultat dans une autre

J'arrive à toutes les compter dans la feuil1 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub COmpter()
 
Dim i As Integer
i = ActiveSheet.Shapes.Count
Cells(12, 4).Value = i
End Sub

Mais je n'arrive pas à les compter dans une plage de cellule donnée

Par contre j'arrive à les lister grâce à ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub listerTaches()
    Dim sh As Shape
    Dim i As Integer
 
    i = 1
    For Each sh In Feuil1.Shapes
        Set inter = Application.Intersect(sh.TopLeftCell, Range("chantier"))
        If Not inter Is Nothing Then
            Feuil1.Range("ED" & i).Value = sh.TextFrame.Characters.Text
            i = i + 1
        End If
    Next
 
End Sub

Pouvez vous m'aider?
Merci

**patricktoulon** · 29/11/2012, 17h12

Bonjour
Je n'ai pas bien regardé ton code, mais dans l'ensemble, pour moi, il te manque une autre boucle imbriquée.
C'est à dire tu boucles sur toutes les cellules d'une plage
et tu boucles sur toutes tes shapes, ainsi à chaque boucle cellule tu demandes le topleftcell de la shape.
Cela devrait te sortir tous les shapes qui sont dans la plage spécifiée.

Au plaisir

**tototiti2008** · 29/11/2012, 18h00

Bonjour tiktak, Bonjour Patrick,

Il me semble que dans la 2ème procédure listerTaches, la valeur de i en fin de boucle devrait te donner le compte, si tu initialises i à 0

**patricktoulon** · 29/11/2012, 18h10

Bonjour

Non i lui donne l'index de la shape mais pas le i de la cellule, donc il ne boucle pas sur une plage spécifiée mais sur tous les shapes.

Et je crois que ce n'est pas ce qu'il veut.

**tototiti2008** · 29/11/2012, 18h30

Re,

Il me semble que comme il n'incrémente son i que dans le cas où le shape fait partie de son Range, i devrait correspondre au nombre de shapes (en l'initialisant à 0)
Mais je peux me tromper...

**patricktoulon** · 29/11/2012, 18h35

Re
Je viens de faire l'essai avec le intersect du topleftcell.address dans une plage specifiée et je n'ai pas d'erreur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub essai_de_comptage_des_shapes_dans_un_range_precis()
Dim i, liste As String
i = 1
For Each sh In Sheets(1).Shapes
Set isect = Application.Intersect(Range(sh.TopLeftCell.Address), Range("b2:c10"))
If Not isect Is Nothing Then
sheets(1).Cells(i, "ed") = sh.Name
i = i + 1
liste = liste & sh.Name & "  " & sh.TopLeftCell.Address & vbCrLf
End If
Next
MsgBox liste
End Sub

Es tu sûr que ta range s'appelle bien "chantier" et que c'est n'est pas plutôt ton sheet.
oupss
Je viens de me rendre compte et surtout comprendre pourquoi tu as une erreur:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set inter = Application.Intersect(sh.TopLeftCell, Range("chantier"))

Or c'est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Set inter = Application.Intersect(range(sh.TopLeftCell.address), Range("chantier"))

edit:
Finalement en relisant tu as raison.
Sélectionner tout - Visualiser dans une fenêtre à part

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set inter = Application.Intersect(sh.TopLeftCell, Range("chantier"))

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set inter = Application.Intersect(range(sh.TopLeftCell.address), Range("chantier"))

Cà donne la même chose, du texte en plus c'est tout.

Dans ce cas là je vois pas où est l'erreur dans son code ???
Peut être à ce moment là une erreur de déclaration de ses variables sur leurs types.
Au plaisir

**mercatog** · 29/11/2012, 19h53

La propriété TopLeftCell renvoit un objet Range
Patrick, Quel est la différence entre Sh.TopLeftCell et Range(Sh.TopLeftCell.address)

Une fonction comme l'a bien précisé tototiti2008 tiré du code de tiktak28 qui compte les Shapes

EDIT
Pour compter les Shapes qui ne débordent pas de la plage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function CountShapes(ByVal Rng As Range) As Integer
Dim B As Range, H As Range
Dim Sh As Shape
Dim i As Integer
 
For Each Sh In Rng.Parent.Shapes
    Set B = Intersect(Sh.BottomRightCell, Rng)
    Set H = Intersect(Sh.TopLeftCell, Rng)
    If Not B Is Nothing And Not H Is Nothing Then
        i = i + 1
        Set B = Nothing
        Set H = Nothing
    End If
Next Sh
CountShapes = i
End Function

Remplace le AND par OR si tu veux compter les Shapes qui "touchent" la plage

**patricktoulon** · 29/11/2012, 20h13

Bonjour mercatog

Lui utilise range("chantier")'chantier étant de type "string" et non "range".
Donc moi j'utilise "address" pour comparer string à string non?

En tout cas sans celà çà ne fonctionnait pas. Si ce n'est pas à cause de çà je ne vois pas très bien pourquoi?

Je n'ai pas bien regardé ton code, mais j'ai cru voir une comparaison avec le "bottomleftcell". Donc si le topleftcell est bon mais le bottom ne l'est pas le shapes n'ai pas pris en compte. C'est çà ?

Au plaisir

**mercatog** · 29/11/2012, 20h20

Range("chantier") est un string?

Tu t'es fatigué à ce que je vois.
Pourquoi tu n'as pas fais aussi Range(Range("chantier").Address)?

Sh.TopLeftCell est un objet Range et Range("Chantier") est un objet Range

Peut être il a oublié d'indiquer la feuille dans son Intersect s'il a plusieurs noms chantier de portée feuille dans diverses feuilles du classeur et que la recherche ne se fait pas sur la feuille active.
Il aurait faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set inter = Application.Intersect(sh.TopLeftCell, Feuil1.Range("chantier"))

**patricktoulon** · 29/11/2012, 20h28

Oui tu as raison, mais ne trouvant aucune erreur dans son code, je cherche pourquoi il dit que çà ne fonctionne pas.
Pour moi, ou une variable est mal déclaré en terme de type ou le range chantier est inexistant sur la feuille active. Je ne vois que çà.
J'aime bien le ".parent ", je n'aurais jamais utilisé cet argument avec une feuille.

Une question:
Le ".parent" dans ta fonction donne bien le sheet.
Si dans l'appel à ta fonction, il n'est pas précisé le ".parent" devient il le "activesheet"?

Cà implique un activate, au cas ou la fonction doit travailler sur un autre sheet que celui qui est actif non?

Au plaisir

**mercatog** · 29/11/2012, 20h43

Oui, j'ai pris en argument la variable Rng As Range
Et pour ne pas se soucier de la feuille active, le .Parent donne la Worksheet (pour être précis) à laquelle appartient la variable Rng

Le Activate ne fonctionnera pas si j'écris dans une cellule X d'une autre Feuil1 la formule

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=CountShapes(Feuil2!B2:E16)

**patricktoulon** · 29/11/2012, 20h50

Donc si j'appelle ta fonction comme ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

CountShapes range("a1:d8")

c'est comme si je disais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

CountShapes sheets(x).range("a1:d8")

'sheets(x) représentant le activesheet
ok çà implique que si je veux travailler sur un autre sheet que celui qui est actif sans l'activer, je dois le préciser.

Et pour finir la dernière action était de récuperer le texte des shapes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Function CountShapes(ByVal Rng As Range, col As Variant) As Integer  'j'ai mis col a variant pouvoir l'injecter en numeric ou string
Dim B As Range, H As Range
Dim Sh As Shape
Dim i As Integer
 
For Each Sh In Rng.Parent.Shapes
    Set B = Intersect(Sh.BottomRightCell, Rng)
    Set H = Intersect(Sh.TopLeftCell, Rng)
    If Not B Is Nothing And Not H Is Nothing Then
        i = i + 1
        Feuil1.Cells(i, col).Value = Sh.TextFrame.Characters.Text
        Set B = Nothing
        Set H = Nothing
    End If
Next Sh
CountShapes = i
End Function

**tiktak28** · 03/12/2012, 09h00

Bonjour,

Tout d'abord merci énormément pour toutes vos réponses constructives.

Ensuite mes codes marchaient bien mais je ne trouvais simplement pas de solution pour pouvoir récupérer dans une cellule précise de la feuille active le nombre de zone(s) de texte présent(s) dans une plage de cellule donnée

"Chantier" correspond au nom que j'ai défini sur la dite plage.

**tiktak28** · 03/12/2012, 10h18

Bon j'ai mis ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub COmpter()
Dim aName As String
Dim myDocument As Worksheet
Dim shp As Shape
Dim i As Integer
aName = ActiveSheet.Name
Set myDocument = Worksheets(aName)
For Each shp In myDocument.Shapes
If Not Intersect(myDocument.range("CONTINENTAL"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.range("CONTINENTAL"), shp.BottomRightCell) Is Nothing Then
i = i + 1
End If
Next shp
Cells(12, 4).Value = i
 
End Sub

**mercatog** · 03/12/2012, 11h25

Avec la fonction donnée en #7, (en remplaçant le AND par OR) tu pouvais simplement faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub test()
 
Feuil1.Cells(14, 2) = CountShapes(Feuil1.Range("CONTINENTAL"))
End Sub

**tiktak28** · 03/12/2012, 12h22

Merci Mercatog, est il possible d'obtenir un décompte des zones de texte qui sont au dessus d'une plage donnée sans pour autant qu'il n'y ait d'intersection?

**patricktoulon** · 03/12/2012, 13h39

bonjour
de la meme maniere mais en testant le row du tofleftcell a la place du intersect
si il est plus petit que ta

plage.row

then

**mercatog** · 03/12/2012, 13h41

Ce n'est pas clair comme question.

**tiktak28** · 03/12/2012, 14h46

Une image vaut mieux que mille discours ^^

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim aName As String
Dim myDocument As Worksheet
Dim shp As Shape
Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer, o As Integer, p As Integer, q As Integer, r As Integer, s As Integer, t As Integer, u As Integer, v As Integer, w As Integer, x As Integer
aName = ActiveSheet.Name
Set myDocument = Worksheets(aName)
For Each shp In myDocument.Shapes
If Not Intersect(myDocument.Range("CONTINENTAL1"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL1"), shp.BottomRightCell) Is Nothing Then
i = i + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL2"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL2"), shp.BottomRightCell) Is Nothing Then
j = j + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL3"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL3"), shp.BottomRightCell) Is Nothing Then
k = k + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL4"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL4"), shp.BottomRightCell) Is Nothing Then
l = l + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL5"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL5"), shp.BottomRightCell) Is Nothing Then
m = m + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL6"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL6"), shp.BottomRightCell) Is Nothing Then
n = n + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL7"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL7"), shp.BottomRightCell) Is Nothing Then
o = o + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL8"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL8"), shp.BottomRightCell) Is Nothing Then
p = p + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL9"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL9"), shp.BottomRightCell) Is Nothing Then
q = q + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL10"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL10"), shp.BottomRightCell) Is Nothing Then
r = r + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL11"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL11"), shp.BottomRightCell) Is Nothing Then
s = s + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL12"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL12"), shp.BottomRightCell) Is Nothing Then
t = t + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL13"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL13"), shp.BottomRightCell) Is Nothing Then
u = u + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL14"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL14"), shp.BottomRightCell) Is Nothing Then
v = v + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL15"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL15"), shp.BottomRightCell) Is Nothing Then
w = w + 1
End If
If Not Intersect(myDocument.Range("CONTINENTAL16"), shp.TopLeftCell) Is Nothing Or _
Not Intersect(myDocument.Range("CONTINENTAL16"), shp.BottomRightCell) Is Nothing Then
x = x + 1
End If
Next shp
Cells(27, 4).Value = i
Cells(27, 12).Value = j
Cells(27, 20).Value = k
Cells(27, 28).Value = l
Cells(27, 36).Value = m
Cells(27, 44).Value = n
Cells(27, 52).Value = o
Cells(27, 60).Value = p
Cells(27, 68).Value = q
Cells(27, 76).Value = r
Cells(27, 84).Value = s
Cells(27, 92).Value = t
Cells(27, 100).Value = u
Cells(27, 108).Value = v
Cells(27, 116).Value = w
Cells(27, 124).Value = x
End Sub