Option Explicit Sub tracercle(ByVal pcentreX As Single, ByVal pcentrey As Single) ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select End Sub Sub trace_cercle() Dim pcentreX As Single Dim pcentrey As Single pcentreX = 100 pcentrey = 100 Call tracercle End Sub
Sub tracerclecoul(ByVal pcentreX As Single, ByVal pcentrey As Single, ByRef coul As String) ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select Selection.ShapeRange.Fill.ForeColor.RGB = coul End Sub Sub trace_cerclecoul() Dim pcentreX As Single Dim pcentrey As Single Dim coul As String pcentreX = 60 pcentrey = 60 If Cells(1, 1) = "o" Then coul = RGB(250, 0, 0) Else coul = RGB(0, 250, 0) End If Call tracerclecoul End Sub
Sub tracercle(Byval pCentreX as single,Byval pCentreY as single) ActiveSheet.Shapes.AddShape(msoShapeOval, pCentreX , pCentreY , 20, 20).Select End Sub Sub trace_cercle() Dim e As Single Dim f As Single e = 20 f = 30 tracercle e,f End Sub
tracercle pcentreX, pcentrey
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionOption Explicit Sub traceligne(ByVal a As Single, ByVal b As Single, ByVal a As Single, ByVal d As Single, ByVal c As Single, ByRef coul As String) 'coordonées ActiveSheet.Shapes.AddLine(b, a, d, c).Select 'épaisseur Selection.ShapeRange.Line.Weight = 3 'couleur Selection.ShapeRange.Line.ForeColor.RGB = coul End Sub Sub tracerclecoul(ByVal pcentreX As Single, ByVal pcentrey As Single, ByRef coul As String) 'coordonées ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select 'couleur Selection.ShapeRange.Fill.ForeColor.RGB = coul End Sub Sub graphe() 'incrément_boucle Dim n As Single Dim m As Single 'coordonées_segment Dim a As Single Dim b As Single Dim c As Single Dim d As Single 'coordonées_cercle Dim pcentreX As Single Dim pcentrey As Single Dim coul As String For n = 2 To 4 a = 0 b = 0 c = 0 d = 0 pcentrey = 0 pcentreX = 0 If Cells(1, n) = "o" Then coul = RGB(200, 0, 0) End If If Cells(1, n) = "t" Then coul = RGB(0, 200, 0) End If If Cells(1, n) = "g" Then coul = RGB(0, 0, 200) End If For m = 2 To 10 If Cells(m, n) = "t" Then pcentrey = Cells(m, 1) End If If a = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then a = Cells(m, 1) b = Cells(m, n) End If If a <> 0 And c = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then c = Cells(m, 1) d = Cells(m, n) traceligne b, a, d, c, coul If pcentrey <> 0 Then pcentreX = CInt(((d - b) / (c - a) * (pcentrey - a)) + b) tracerclecoul pcentreX, pcentrey, coul End If End If If c <> 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then a = c b = d c = Cells(m, 1) d = Cells(m, n) traceligne b, a, d, c, coul If pcentrey <> 0 Then pcentreX = CInt(((d - b) / (c - a) * (pcentrey - a)) + b) tracerclecoul pcentreX, pcentrey, coul End If End If Next m Next n End Sub
Option Explicit Sub traceligne(ByVal a As Single, ByVal b As Single, ByVal a As Single, ByVal d As Single, ByVal c As Single, ByVal coul As Long) 'coordonées ActiveSheet.Shapes.AddLine(b, a, d, c).Select 'épaisseur Selection.ShapeRange.Line.Weight = 3 'couleur Selection.ShapeRange.Line.ForeColor.RGB = coul End Sub Sub tracerclecoul(ByVal pcentreX As Single, ByVal pcentrey As Single, ByVal coul As Long) 'coordonées ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select 'couleur Selection.ShapeRange.Fill.ForeColor.RGB = coul End Sub Sub graphe() 'incrément_boucle Dim n As Single Dim m As Single 'coordonées_segment Dim a As Single Dim b As Single Dim c As Single Dim d As Single 'coordonées_cercle Dim pcentreX As Single Dim pcentrey As Single Dim coul As String For n = 2 To 4 a = 0 b = 0 c = 0 d = 0 pcentrey = 0 pcentreX = 0 If Cells(1, n) = "o" Then coul = RGB(200, 0, 0) End If If Cells(1, n) = "t" Then coul = RGB(0, 200, 0) End If If Cells(1, n) = "g" Then coul = RGB(0, 0, 200) End If For m = 2 To 10 If Cells(m, n) = "t" Then pcentrey = Cells(m, 1) End If If a = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then a = Cells(m, 1) b = Cells(m, n) End If If a <> 0 And c = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then c = Cells(m, 1) d = Cells(m, n) traceligne b, a, d, c, coul If pcentrey <> 0 Then pcentreX = CInt(((d - b) / (c - a) * (pcentrey - a)) + b) tracerclecoul pcentreX, pcentrey, coul End If End If If c <> 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then a = c b = d c = Cells(m, 1) d = Cells(m, n) traceligne b, a, d, c, coul If pcentrey <> 0 Then pcentreX = CInt(((d - b) / (c - a) * (pcentrey - a)) + b) tracerclecoul pcentreX, pcentrey, coul End If End If Next m Next n End Sub
Option Explicit Sub traceligne(ByVal a As Single, ByVal b As Single, ByVal d As Single, ByVal c As Single, ByVal pColor As Long) 'coordonées ActiveSheet.Shapes.AddLine(b, a, d, c).Select 'épaisseur Selection.ShapeRange.Line.Weight = 3 'couleur Selection.ShapeRange.Line.ForeColor.RGB = pColor End Sub Sub tracerclecoul(ByVal pCentreX As Single, ByVal pCentrey As Single, ByVal pColor As Long) 'coordonées ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select 'couleur Selection.ShapeRange.Fill.ForeColor.RGB = pColor End Sub Sub graphe() 'incrément_boucle Dim n As Single Dim m As Single 'coordonées_segment Dim a As Single Dim b As Single Dim c As Single Dim d As Single 'coordonées_cercle Dim lCentreX As Single Dim lCentreY As Single Dim lColor As Long For n = 2 To 4 a = 0 b = 0 c = 0 d = 0 lcentrey = 0 lcentreX = 0 If Cells(1, n) = "o" Then lColor = RGB(200, 0, 0) End If If Cells(1, n) = "t" Then lColor = RGB(0, 200, 0) End If If Cells(1, n) = "g" Then lColor = RGB(0, 0, 200) End If For m = 2 To 10 If Cells(m, n) = "t" Then lcentrey = Cells(m, 1) End If If a = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then a = Cells(m, 1) b = Cells(m, n) End If If a <> 0 And c = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then c = Cells(m, 1) d = Cells(m, n) traceligne a, b, d, c, lColor If lcentrey <> 0 Then lcentreX = CInt(((d - b) / (c - a) * (lcentrey - a)) + b) tracerclecoul lcentreX, lcentrey, lColor End If End If If c <> 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then a = c b = d c = Cells(m, 1) d = Cells(m, n) traceligne b, a, d, c, lColor If lcentrey <> 0 Then lcentreX = CInt(((d - b) / (c - a) * (lcentrey - a)) + b) tracerclecoul lcentreX, lcentrey, lColor End If End If Next m Next n End Sub
Sub traceligne(ByVal b As Single, ByVal a As Single, ByVal d As Single, ByVal c As Single, ByVal c As Single, ByVal coul As Long)