Discussion :

[xomus]

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 :

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

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

[mercatog]

Voilà le travail fait à ta place.

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

[riaolle]

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

[xomus]

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

[mercatog]

Basiquement oui
Retrousse les manches

[xomus]

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

[xomus]

Bonjour,
Je voudrais mettre un cercle de 0 ( pour la matrice cable) dans une matrice buse ,
voici le 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
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