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, ...
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
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
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" <garnote3@videotron.ca> a écrit dans le message de news:
uG8fN8dFKHA.4732@TK2MSFTNGP04.phx.gbl...
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, ...
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
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
Tu n'aurais pas un petit fichier pour nous Garnote,
illustrant ce que tu énonces ?
"garnote" <garnote3@videotron.ca> a écrit dans le message de groupe de discussion :
eoRSyweFKHA.3396@TK2MSFTNGP04.phx.gbl...
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" <garnote3@videotron.ca> a écrit dans le message de news:
uG8fN8dFKHA.4732@TK2MSFTNGP04.phx.gbl...
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, ...
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
garnote
Bon, tu vas encore me trouver des imperfections :-)))
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
Bon, tu vas encore me trouver des imperfections :-)))
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
Oud8gnfFKHA.5780@TK2MSFTNGP03.phx.gbl...
Tu n'aurais pas un petit fichier pour nous Garnote,
illustrant ce que tu énonces ?
"garnote" <garnote3@videotron.ca> a écrit dans le message de groupe de
discussion :
eoRSyweFKHA.3396@TK2MSFTNGP04.phx.gbl...
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" <garnote3@videotron.ca> a écrit dans le message de news:
uG8fN8dFKHA.4732@TK2MSFTNGP04.phx.gbl...
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, ...
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
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 !
;-))
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 !
Ce serait encore mieux s'il y avait des petites flèches pointant sur chaque vertices !
;-))
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 !
;-))
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" <michdenis@hotmail.com> a écrit dans le message de news:
%234yVZBgFKHA.4168@TK2MSFTNGP05.phx.gbl...
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 !
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 !
;-))
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 !
;-))
C'est super Garnote.
Du travail bien fait !
;-)
"garnote" <garnote3@videotron.ca> a écrit dans le message de groupe de discussion :
#4eZRdgFKHA.4316@TK2MSFTNGP02.phx.gbl...
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" <michdenis@hotmail.com> a écrit dans le message de news:
%234yVZBgFKHA.4168@TK2MSFTNGP05.phx.gbl...
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" 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 !
;-))
Modeste
Bonsour® Toé avec ferveur ;o))) tu jasais :
Bon, tu vas encore me trouver des imperfections :-)))
pas marrant ton jeu !!!!! toujours le même score .... erreur 438 ;o)))
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 !
;-))
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" <garnote3@videotron.ca> a écrit dans le message de groupe de discussion :
#4eZRdgFKHA.4316@TK2MSFTNGP02.phx.gbl...
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" <michdenis@hotmail.com> a écrit dans le message de news:
%234yVZBgFKHA.4168@TK2MSFTNGP05.phx.gbl...
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 !
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 !
;-))
Modeste
Bonsour® Serge :
Bonsour® Toé avec ferveur ;o))) tu jasais :
Bon, tu vas encore me trouver des imperfections :-)))