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