Cercle d'une matrice

Bonjour ,
J'espere que vous allez m'aider pour cette fonction
Mon probleme ?
j'ai une matrice ( qui est une MatCable la premiere colonne ( rayon) , la deuxieme colonne (coordonnée x) , la 3 eme colonne ( coordonnée y)
je voudrais dessiner un cercle de cette matrice , et merci

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Public Function insertCableS( MatCable As Variant) As Shape   Dim rC, xC, yC As Double   Dim l, c As Integer: l = UBound(MatCable, 1): c = UBound(MatCable, 2)       For i = 1 To l: rC = MatCable(i, 1): xC = MatCable(i, 2): yC = MatCable(i, 3) Set insertCableS = ActiveSheet.Shapes.AddShape(msoShapeOval, xC, yC, rC, rC) Next End Function

---

Voilà le travail fait à ta place.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Sub TraceCable() Dim Shp As Shape Dim i As Long Dim Tb   Tb = Worksheets("Feuil1").Range("A2:C7") ' à adapter For i = 1 To UBound(Tb, 1) Set Shp = Worksheets("Feuil1").Shapes.AddShape(msoShapeOval, Tb(i, 2), Tb(i, 3), Tb(i, 1), Tb(i, 1)) With Shp .Name = "Cable" & i .Fill.Visible = msoFalse '..... End With Set Shp=Nothing Next i End Sub

---

Bonjour,
Attention à la façon dont tu poses ta question sur le forum. Tu obtiendras plus efficacement des réponses si tu te tiens aux quelques règles du forum.
http://club.developpez.com/regles/#LIV-H
http://club.developpez.com/regles/#LIV-N

Merci infiniment , y a t il une possibilité de ramener ( diametre , coordonée du cable) à partir de la matrice non pas de la feuille

Basiquement oui
Retrousse les manches

Le Nom du cercle et son 'i' , n'apparait pas est ce Normal?

C'etait un exemple si on voulait nommer chaque cable dans un but pédagogique et ce, pour te montrer comment travailler avec la variable objet (shape) Shp
Ce n' est pas nécessaire

Code:

---

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

Function TraceCable(D As Double, MatCable As Variant, color As Variant) As Variant Dim Shp As Shape Dim coul As Long Dim i As Long Call trace_buse(D / 200, D / 200, D)   MatCable = Worksheets("Feuil1").Range("A2:C12") ' à adapter For i = 1 To UBound(MatCable, 1) Set Shp = Worksheets("Feuil1").Shapes.AddShape(msoShapeOval, MatCable(i, 2), MatCable(i, 3), MatCable(i, 1), MatCable(i, 1)) If color = rouge Then coul = RGB(255, 0, 0) Shp.Fill.ForeColor.RGB = coul End If If color = bleu Then coul = RGB(0, 0, 255) Shp.Fill.ForeColor.RGB = coul End If If color = vert Then coul = RGB(0, 255, 0) Shp.Fill.ForeColor.RGB = coul End If If color = jaune Then coul = RGB(255, 255, 0) Shp.Fill.ForeColor.RGB = coul End If If color = noir Then coul = RGB(0, 0, 0) Shp.Fill.ForeColor.RGB = coul End If If color = blanc Then coul = RGB(255, 255, 255) Shp.Fill.ForeColor.RGB = coul End If Next i End Function

---

moon probleme quand j'appelle la fonction par

Code:

---

1 2 3

Sub testeury() Call TraceCable(200, MatCable, noir) End Sub

---

ca me donne toujours la derniere couleur blanche :(

Que contient les variable bleu, rouge, vert, noir...etx

As tu mis en haut du Module

Code:

---

Option Explicit

---

..

Oui j'ai mis Option explicite
quand j'appelle la fonction par exemple

Code:

---

1 2 3

Sub testeury() Call TraceCable(200, MatCable, noir) End Sub

---

à savoir

Code:

---

1 2 3 4

If color = noir Then coul = RGB(0, 0, 0) Shp.Fill.ForeColor.RGB = coul End If

---

ça me donne le dérnier If ( ça veut dire la couleur Blanche)

Que contient la variable noir?

Et où elle est définie?

Code:

---

Function TraceCable(D As Double, MatCable As Variant, color As Variant)

---

Color prends a chaque fois une couleur non?

Tu as une variable que tu as nommé noir

Qu'est ce qu'elle représente?

Si tu sous entends que si tu écris noir vba va l'interpréter comme la couleur noire alors je te dirai: Oh mon Dieu!
Tu crois que vba comprendra le français?

Bonjour,

Citation:

---

Envoyé par mercatog

Tu crois que vba comprendra le français?

---

Je ne suis même pas sûr que lui-même ne comprenne le français. ;) :boulet:

Cela faut bien une semaine et demie qu'il revient avec sa fonction à rallonge, toujours boguée à un endroit différent, qu'il devait remettre, il y a deux lundis. Il n'a jamais été foutu de répondre à la question de c'est quoi le but de tout cela ? (Cela fait qu'aucun répondeur présent (toi) ou passé (moi, Philippe Tulliez, unparia, Joe.levrai, Jean-Phipippe André et probablement d'autres que j'oublie (toutes mes excuses)) répondent sans savoir si son approche a la moindre chance s'être la bonne.

Et puis moi, on m'a toujours dit qu'une fonction devait retourner une valeur, ou, par extension, un ensemble de valeurs. Et que ce n'est pas fait pour faire des dessins. Donc, même s'il s'en sacre, cela a toutes les apparences qu'il est dans le champ.

Il devrait demander un remboursement à son école de broche-à-foin qui l'a envoyé dans un stage où il doit connaître VBA, sans le lui avoir enseigné. :furax::furieux::applo::bravo:

Méchanceté gratuite.

Code:

---

1 2 3

Sub testeury() Call TraceCable(200, MatCable, "noir") End Sub

---

Code:

---

1 2 3 4

If color = "noir" Then coul = RGB(0, 0, 0) Shp.Fill.ForeColor.RGB = coul End If

---

Cela dit, appeler "color" une variable ou un paramètre, c'est vraiment chercher les ennuis... :?

Citation:

---

Méchanceté gratuite.

---

Beaucoup de choses sont gratuites aujourd'hui, y compris certains petits mensonges et boniments (bien qu'ils n'aient, tu le vois, pas été "payants"). ;)

Citation:

---

Envoyé par xomus

Méchanceté gratuite.

---

Commence donc par prouver qu'il y a des faussetés dans cette supposée méchanceté.

"Aide-toi et le Ciel t'aidera"

Tu as un code mal foutu, emprisonné dans une fonction qui n'est pas faite pour dessiner sur une feuille ou n'importe où ailleurs et tu refuses de faire le minimum d'efforts pour faciliter la vie de ceux qui essaient de te répondre. Tu risques de t'attirer les foudres de la Direction du forum pour l'abus de "up", parce que personne n'est obligé de répondre...

Bonjour,

a-t-on pu avancer sur ce sujet qui semble s'eterniser un peu pour pas grand chose ?

Que valent tes variables noir, rouge et compagnie ?

As-tu pris le temps et l'energie necessaire pour faire des essais a partir de ce que Menhir t'a propose par exemple ?

Nous donnons des pistes pour pecher correctement, mais on ne pechera pas pour toi =]

Bonjour,
Je voudrais mettre un cercle de 0 ( pour la matrice cable) dans une matrice buse ,
voici le code

Code:

---

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

Public Function InsertionCables(matBuse As Variant, MatCable As Variant) As Variant   lb = UBound(matBuse, 1): cb = UBound(matBuse, 2): lc = UBound(MatCable, 1): cc = UBound(MatCable, 2)   Dim matBuse2 As Variant: matBuse2 = matBuse   'ReDim matBuse(1 To lb, 1 To cb) As Integer: ReDim MatCable(1 To lc, 1 To cc) As Integer check = "no" For i = 1 To lb: For j = 1 To cb   If i - Val(lc / 2) > 0 And j - Val(lc / 2) > 0 And i + Val(lc / 2) < lb And j + Val(lc / 2) < lb Then   For k = 1 To Val(lc / 2): For l = 1 To Val(lc / 2)   If matBuse(i, j) = 1 And matBuse(i - k, j - l) = 1 And matBuse(i + k, j + l) = 1 And matBuse(i - k, j + l) = 1 And matBuse(i + k, j - l) = 1 Then check = "ok" Else: check = "no"   If check <> "ok" Then Exit For: Exit For   Next l: Next k End If   'MsgBox check If check = "ok" Then   For k = 1 To Val(lc / 2): For l = 1 To Val(lc / 2) If i - Val(lc / 2) > 0 And j - Val(lc / 2) > 0 And i + Val(lc / 2) < lb And j + Val(lc / 2) < lb Then matBuse2(i - k, j - l) = 0: matBuse2(i + k, j + l) = 0: matBuse2(i - k, j + l) = 0: matBuse2(i + k, j - l) = 0: End If Next l: Next k   Exit For: Exit For   End If   Next j: Next i InsertionCables = matBuse2 End Function

---

et voici pour affSub test_insertion()
Dim MC, MB, MB2 As Variant

MC = mat_cercle(mat_Carré(5, 1))
MB = mat_cercle(mat_Carré(30, 1))



MB2 = InsertionCables(MB, MC)

affichResult (MB2)

End Sub
icher
et le resultat le voici :(
Pièce jointe 297072