Nombre de sommets d'une forme llibre

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
garnote
Le #19887191
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"
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



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


"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"
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



garnote
Le #19887741
Bon, tu vas encore me trouver des imperfections :-)))

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

Moé

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


"garnote" 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"
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






MichDenis
Le #19887921
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 !

;-))
garnote
Le #19888171
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" %
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 !

;-))



MichDenis
Le #19888151
C'est super Garnote.

Du travail bien fait !
;-)



"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" %
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 !

;-))



Modeste
Le #19888271
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)))
MichDenis
Le #19888261
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" #
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" %
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 !

;-))



Modeste
Le #19888361
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)))
garnote
Le #19888991
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"
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)))
Publicité
Poster une réponse
Anonyme