Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 Code VBA qui ne fonctionne pas

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

nullosse

XLDnaute Occasionnel
Salut,
qui peut me dire pourquoi ce code ne fonctionne pas ? :
VB:
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
 
Bonjour,
je te propose ma correction.
VB:
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
 
Dernière édition:
Bonjour,
la mienne (à lancer depuis la feuille et non dans le VBE)
VB:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
903
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
585
Réponses
0
Affichages
652
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…