Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Nombre de sommets d'une forme llibre

Nombre de sommets d'une forme llibre

10 réponses
Avatar
garnote
Bonjour,

J'ai inséré une forme libre à six sommets que j'ai
nommée "dessin". Et cette macro m'a permis de
trouver les coordonnées de chaque sommet :

Sub Identifie_Sommets()
With ActiveSheet.Shapes("dessin")
sommets = .Vertices
For i = 1 To 6
For j = 1 To 2
Cells(i, j) = sommets(i, j)
Next j
Next i
End With
End Sub

Question :
Comment faire en VBA pour obtenir le nombre de sommets
d'une forme libre ?
Count, Items, Ubound, ...

Serge
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
garnote
Je crois que j'ai enfin trouvé :
Sélectionner une forme libre et appeler cette macro :

Sub Compte_Et_Identifie_Sommets_Forme_Libre()
With Selection
sommets = .Vertices
ns = UBound(sommets)
For i = 1 To ns
For j = 1 To 2
Cells(i, j) = sommets(i, j)
Next j
Next i
End With
MsgBox ns
End Sub

Serge


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

Bonjour,

J'ai inséré une forme libre à six sommets que j'ai
nommée "dessin". Et cette macro m'a permis de
trouver les coordonnées de chaque sommet :

Sub Identifie_Sommets()
With ActiveSheet.Shapes("dessin")
sommets = .Vertices
For i = 1 To 6
For j = 1 To 2
Cells(i, j) = sommets(i, j)
Next j
Next i
End With
End Sub

Question :
Comment faire en VBA pour obtenir le nombre de sommets
d'une forme libre ?
Count, Items, Ubound, ...

Serge



Avatar
MichDenis
Tu n'aurais pas un petit fichier pour nous Garnote,
illustrant ce que tu énonces ?


"garnote" a écrit dans le message de groupe de discussion :

Je crois que j'ai enfin trouvé :
Sélectionner une forme libre et appeler cette macro :

Sub Compte_Et_Identifie_Sommets_Forme_Libre()
With Selection
sommets = .Vertices
ns = UBound(sommets)
For i = 1 To ns
For j = 1 To 2
Cells(i, j) = sommets(i, j)
Next j
Next i
End With
MsgBox ns
End Sub

Serge


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

Bonjour,

J'ai inséré une forme libre à six sommets que j'ai
nommée "dessin". Et cette macro m'a permis de
trouver les coordonnées de chaque sommet :

Sub Identifie_Sommets()
With ActiveSheet.Shapes("dessin")
sommets = .Vertices
For i = 1 To 6
For j = 1 To 2
Cells(i, j) = sommets(i, j)
Next j
Next i
End With
End Sub

Question :
Comment faire en VBA pour obtenir le nombre de sommets
d'une forme libre ?
Count, Items, Ubound, ...

Serge



Avatar
garnote
Bon, tu vas encore me trouver des imperfections :-)))

http://www.cijoint.fr/cjlink.php?file=cj200908/cijhTWrfoI.xls

Moé

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

Tu n'aurais pas un petit fichier pour nous Garnote,
illustrant ce que tu énonces ?


"garnote" a écrit dans le message de groupe de
discussion :

Je crois que j'ai enfin trouvé :
Sélectionner une forme libre et appeler cette macro :

Sub Compte_Et_Identifie_Sommets_Forme_Libre()
With Selection
sommets = .Vertices
ns = UBound(sommets)
For i = 1 To ns
For j = 1 To 2
Cells(i, j) = sommets(i, j)
Next j
Next i
End With
MsgBox ns
End Sub

Serge


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

Bonjour,

J'ai inséré une forme libre à six sommets que j'ai
nommée "dessin". Et cette macro m'a permis de
trouver les coordonnées de chaque sommet :

Sub Identifie_Sommets()
With ActiveSheet.Shapes("dessin")
sommets = .Vertices
For i = 1 To 6
For j = 1 To 2
Cells(i, j) = sommets(i, j)
Next j
Next i
End With
End Sub

Question :
Comment faire en VBA pour obtenir le nombre de sommets
d'une forme libre ?
Count, Items, Ubound, ...

Serge






Avatar
MichDenis
Merci, c'est très bien.

| Bon, tu vas encore me trouver des imperfections

Ce serait encore mieux s'il y avait des petites flèches pointant
sur chaque vertices !

;-))
Avatar
garnote
Ou avec de petits disques approximatifs :-)

Sub Compte_Et_Identifie_Sommets_Forme_Libre()
Range("A:B").ClearContents
Range("A1") = "Left"
Range("B1") = "Top"
With Selection
sommets = .Vertices
ns = UBound(sommets)
For i = 1 To ns
For j = 1 To 2
Cells(i + 1, j) = sommets(i, j)
Next j
ActiveSheet.Shapes.AddShape msoShapeOval, _
Cells(i + 1, 1) - 2, Cells(i + 1, 2) - 2, 4, 4
Next i
End With
DoEvents
MsgBox "Nombre de sommets : " & ns
End Sub





"MichDenis" a écrit dans le message de news:
%
Merci, c'est très bien.

| Bon, tu vas encore me trouver des imperfections

Ce serait encore mieux s'il y avait des petites flèches pointant
sur chaque vertices !

;-))



Avatar
MichDenis
C'est super Garnote.

Du travail bien fait !
;-)



"garnote" a écrit dans le message de groupe de discussion :
#
Ou avec de petits disques approximatifs :-)

Sub Compte_Et_Identifie_Sommets_Forme_Libre()
Range("A:B").ClearContents
Range("A1") = "Left"
Range("B1") = "Top"
With Selection
sommets = .Vertices
ns = UBound(sommets)
For i = 1 To ns
For j = 1 To 2
Cells(i + 1, j) = sommets(i, j)
Next j
ActiveSheet.Shapes.AddShape msoShapeOval, _
Cells(i + 1, 1) - 2, Cells(i + 1, 2) - 2, 4, 4
Next i
End With
DoEvents
MsgBox "Nombre de sommets : " & ns
End Sub





"MichDenis" a écrit dans le message de news:
%
Merci, c'est très bien.

| Bon, tu vas encore me trouver des imperfections

Ce serait encore mieux s'il y avait des petites flèches pointant
sur chaque vertices !

;-))



Avatar
Modeste
Bonsour® Toé avec ferveur ;o))) tu jasais :

Bon, tu vas encore me trouver des imperfections :-)))

http://www.cijoint.fr/cjlink.php?file=cj200908/cijhTWrfoI.xls

Moé



pas marrant ton jeu !!!!!
toujours le même score ....
erreur 438
;o)))
Avatar
MichDenis
Voici la même procédure que dans le fichier que tu as publié
mais légèrement modifié pour effacer en autre les petits ronds !

'------------------------------------------------
Sub Compte_Et_Identifie_Sommets_Forme_Libre()
With Feuil1
.Range("A:B").ClearContents
For Each Sh In .Shapes
If TypeName(Sh.OLEFormat.Object) = "Oval" Then
Sh.Delete
End If
Next
.Range("A1") = "Left"
.Range("B1") = "Top"
With .Shapes("Forme libre 5")
sommets = .Vertices
End With
ns = UBound(sommets)
For i = 1 To ns
For j = 1 To 2
.Cells(i + 1, j) = sommets(i, j)
Next j
.Shapes.AddShape msoShapeOval, _
Cells(i + 1, 1) - 2, Cells(i + 1, 2) - 2, 4, 4
Next i
End With
Application.ScreenUpdating = True
MsgBox "Nombre de sommets : " & ns
End Sub
'------------------------------------------------



"garnote" a écrit dans le message de groupe de discussion :
#
Ou avec de petits disques approximatifs :-)

Sub Compte_Et_Identifie_Sommets_Forme_Libre()
Range("A:B").ClearContents
Range("A1") = "Left"
Range("B1") = "Top"
With Selection
sommets = .Vertices
ns = UBound(sommets)
For i = 1 To ns
For j = 1 To 2
Cells(i + 1, j) = sommets(i, j)
Next j
ActiveSheet.Shapes.AddShape msoShapeOval, _
Cells(i + 1, 1) - 2, Cells(i + 1, 2) - 2, 4, 4
Next i
End With
DoEvents
MsgBox "Nombre de sommets : " & ns
End Sub





"MichDenis" a écrit dans le message de news:
%
Merci, c'est très bien.

| Bon, tu vas encore me trouver des imperfections

Ce serait encore mieux s'il y avait des petites flèches pointant
sur chaque vertices !

;-))



Avatar
Modeste
Bonsour® Serge :

Bonsour® Toé avec ferveur ;o))) tu jasais :

Bon, tu vas encore me trouver des imperfections :-)))

http://www.cijoint.fr/cjlink.php?file=cj200908/cijhTWrfoI.xls

Moé



pas marrant ton jeu !!!!!
toujours le même score ....
erreur 438
;o)))



résolu !!!!
Excel 2002
il a fallut que je génére moi-même ma forme libre ... ???

qu'est-ce que tu envisages comme utilisation pratique ???
;o)))
Avatar
garnote
qu'est-ce que tu envisages comme utilisation pratique ???
;o)))

Comme DAB (la bière), je vais tenter
de joindre l'inutile à l'agréable :-)


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

Bonsour® Serge :

Bonsour® Toé avec ferveur ;o))) tu jasais :

Bon, tu vas encore me trouver des imperfections :-)))

http://www.cijoint.fr/cjlink.php?file=cj200908/cijhTWrfoI.xls

Moé



pas marrant ton jeu !!!!!
toujours le même score ....
erreur 438
;o)))



résolu !!!!
Excel 2002
il a fallut que je génére moi-même ma forme libre ... ???

qu'est-ce que tu envisages comme utilisation pratique ???
;o)))