XL 2021 Code VBA qui ne fonctionne pas

[nullosse]

Salut,
qui peut me dire pourquoi ce code ne fonctionne pas ? :

Sub AnalyseProcessus()
    Dim ws As Worksheet
    Dim t As Double
    Dim v(1 To 4) As Single
    Dim i As Long
   
    Set ws = ActiveSheet
    t = Timer
   
    ' Génération de paramètres pseudo-aléatoires
    For i = 1 To 4
        v(i) = (Sin(t * i) + 1) * 50 + 80
    Next i
   
    ' Appel de la routine graphique interne
    Call RenderDiagnostic(ws, v)
End Sub


Private Sub RenderDiagnostic(ws As Worksheet, p() As Single)
    Dim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape, txt As Shape
    Dim x As Single, y As Single
   
    ' Positionnement basé sur les paramètres
    x = p(1)
    y = p(2)
   
    ' Élément principal
    Set s1 = ws.Shapes.AddShape(msoShapeOval, x, y, 200, 100)
    s1.Fill.ForeColor.RGB = RGB(255, 153, 51)
    s1.Line.ForeColor.RGB = RGB(0, 0, 0)
   
    ' Élément secondaire
    Set s2 = ws.Shapes.AddShape(msoShapeIsoscelesTriangle, x - 60, y + 20, 80, 60)
    s2.Rotation = 90
    s2.Fill.ForeColor.RGB = RGB(255, 204, 102)
   
    ' Élément optique
    Set s3 = ws.Shapes.AddShape(msoShapeOval, x + 150, y + 25, 15, 15)
    s3.Fill.ForeColor.RGB = RGB(255, 255, 255)
   
    Set s4 = ws.Shapes.AddShape(msoShapeOval, x + 155, y + 30, 6, 6)
    s4.Fill.ForeColor.RGB = RGB(0, 0, 0)
   
    ' Texte généré dynamiquement
    msg = Chr(80) & Chr(111) & Chr(105) & Chr(115) & Chr(115) & Chr(111) & Chr(110) _
        & Chr(32) & Chr(100) & Chr(39) & Chr(97) & Chr(118) & Chr(114) & Chr(105) & Chr(108)
   
    Set txt = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, x + 20, y - 35, 200, 30)
    txt.TextFrame2.TextRange.Text = msg
    txt.TextFrame2.TextRange.Font.Size = 18
    txt.TextFrame2.TextRange.Font.Bold = msoTrue
    txt.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 102, 204)
End Sub

Nullosse

 

[dysorthographie]

Bonjour,
je te propose ma correction.

Sub AnalyseProcessus()
    Dim ws As Worksheet
    Dim t As Double
    Dim v(1 To 4) As Single
    Dim i As Long
 
    Set ws = ActiveSheet
    t = Timer
 
    ' Génération de paramètres pseudo-aléatoires
    For i = 1 To 4
        v(i) = (Sin(t * i) + 1) * 50 + 80
    Next i
 
    ' Appel de la routine graphique interne
    Call RenderDiagnostic(ws, v)
End Sub


Private Sub RenderDiagnostic(ws As Worksheet, p() As Single)
    Dim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape, txt As Shape
    Dim x As Single, y As Single
    Dim i As Long, j As Long
    Dim ecaille As Shape
    Dim msg As String
 
    ' Positionnement basé sur les paramètres
    x = p(1)
    y = p(2)
 
    ' Élément principal
    Set s1 = ws.Shapes.AddShape(msoShapeOval, x, y, 200, 100)
    s1.Fill.ForeColor.RGB = RGB(255, 153, 51)
    s1.Line.ForeColor.RGB = RGB(0, 0, 0)
 
    ' Motif répétitif 
    For i = 0 To 4
        For j = 0 To 2
            Set ecaille = ws.Shapes.AddShape(msoShapeOval, _
                x + 20 + i * 35, _
                y + 20 + j * 25, _
                20, 15)
            ecaille.Fill.ForeColor.RGB = RGB(255, 178, 102)
            ecaille.Line.Visible = msoFalse
        Next j
    Next i
 
    ' Élément secondaire
    Set s2 = ws.Shapes.AddShape(msoShapeIsoscelesTriangle, x - 60, y + 20, 80, 60)
    s2.Rotation = 90
    s2.Fill.ForeColor.RGB = RGB(255, 204, 102)
 
    ' Élément optique
    Set s3 = ws.Shapes.AddShape(msoShapeOval, x + 150, y + 25, 15, 15)
    s3.Fill.ForeColor.RGB = RGB(255, 255, 255)
 
    Set s4 = ws.Shapes.AddShape(msoShapeOval, x + 155, y + 30, 6, 6)
    s4.Fill.ForeColor.RGB = RGB(0, 0, 0)
 
    ' Texte
    msg = Chr(80) & Chr(111) & Chr(105) & Chr(115) & Chr(115) & Chr(111) & Chr(110) _
        & Chr(32) & Chr(100) & Chr(39) & Chr(97) & Chr(118) & Chr(114) & Chr(105) & Chr(108)
 
    Set txt = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, x + 20, y - 35, 200, 30)
    txt.TextFrame2.TextRange.Text = msg
    txt.TextFrame2.TextRange.Font.Size = 18
    txt.TextFrame2.TextRange.Font.Bold = msoTrue
    txt.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 102, 204)
End Sub

 

[crocrocro]

Bonjour,
la mienne (à lancer depuis la feuille et non dans le VBE)

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub AnalyseProcessus()
    Dim ws As Worksheet
    Dim t As Double
    Dim v(1 To 4) As Single
    Dim i As Long
   
    Set ws = ActiveSheet
    t = Timer
   
    ' Génération de paramètres pseudo-aléatoires
    For i = 1 To 4
        v(i) = (Sin(t * i) + 1) * 50 + 80
    Next i
   
    ' Appel de la routine graphique interne
    Call RenderDiagnostic(ws, v)
End Sub


Private Sub RenderDiagnostic(ws As Worksheet, p() As Single)
    Dim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape, s5 As Shape, txt As Shape
    Dim x As Single, y As Single

    ' Positionnement basé sur les paramètres
    x = p(1)
    y = p(2)
   
    ' Élément principal
    Set s1 = ws.Shapes.AddShape(msoShapeOval, x, y, 200, 100)
    s1.Fill.ForeColor.RGB = RGB(255, 153, 51)
    s1.Line.ForeColor.RGB = RGB(0, 0, 0)
   
    ' Élément secondaire
    Set s2 = ws.Shapes.AddShape(msoShapeIsoscelesTriangle, x - 60, y + 20, 80, 60)
    s2.Rotation = 90
    s2.Fill.ForeColor.RGB = RGB(255, 204, 102)
   
    ' Élément optique
    Set s3 = ws.Shapes.AddShape(msoShapeOval, x + 150, y + 25, 15, 15)
    s3.Fill.ForeColor.RGB = RGB(255, 255, 255)
   
    Set s4 = ws.Shapes.AddShape(msoShapeOval, x + 155, y + 30, 6, 6)
    s4.Fill.ForeColor.RGB = RGB(0, 0, 0)
   

    
    ActiveSheet.Shapes.SelectAll
    Selection.ShapeRange.Group.Select
    Set groupe = Selection
    ' Élément gênant
    Set s5 = ws.Shapes.AddShape(msoShapeOval, x - 80, y - 120, 1000, 300)
    s5.Fill.ForeColor.RGB = RGB(189, 215, 238)
    s5.Line.ForeColor.RGB = RGB(0, 0, 0)
    s5.ZOrder msoSendToBack
    [A1].Select
    With groupe
        For i = 1 To 100
            Sleep 10
            groupe.Left = groupe.Left + 7
            DoEvents
        Next i
    End With
    
        ' Texte généré dynamiquement
    msg = Chr(80) & Chr(111) & Chr(105) & Chr(115) & Chr(115) & Chr(111) & Chr(110) _
        & Chr(32) & Chr(100) & Chr(39) & Chr(97) & Chr(118) & Chr(114) & Chr(105) & Chr(108)
   
    Set txt = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, x + 100, y - 35, 150, 30)
    txt.TextFrame2.TextRange.Text = msg
    txt.TextFrame2.TextRange.Font.Size = 18
    txt.TextFrame2.TextRange.Font.Bold = msoTrue
    txt.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 102, 204)
End Sub