XL 2019 Problème exécution VBA

Sam0995

XLDnaute Nouveau
Bonjour,

J'ai un code VBA présent sur 3 pages de mon classeur excel.
Ce code permet de déplacer une forme selon la valeur d'une cellule présente dans cette même feuille. La valeur de cette cellule est elle dépendante d'une autre feuille qui est modifié régulièrement. Mon problème est que pour faire déplacer ces formes je dois à chaque fois entrer dans la cellule et la valider si non elle la forme ne bouge pas malgré que la valeur de la cellule lié à changé. Avez-vous une astuce pour que les formes bougent automatiquement sans avoir besoin de venir valider les cellules ?

Merci par avance


Voici mon code :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim ges As Long
Dim num_ligne_ges As Long
Dim nrj As Long
Dim num_ligne_nrj As Long

If Target.Address = "$E$44" Then

ges = ActiveSheet.Range("E44")
num_ligne_ges = ActiveSheet.Range("E44")

If ges >= 0 Then

If ges >= 0 And num_ligne_ges <= 5 Then

num_ligne_ges = 56

ElseIf ges >= 6 And num_ligne_ges <= 10 Then

num_ligne_ges = 57

ElseIf ges >= 11 And num_ligne_ges <= 20 Then

num_ligne_ges = 58

ElseIf ges >= 21 And num_ligne_ges <= 35 Then

num_ligne_ges = 59

ElseIf ges >= 36 And num_ligne_ges <= 55 Then

num_ligne_ges = 60

ElseIf ges >= 56 And num_ligne_ges <= 80 Then

num_ligne_ges = 61

Else

num_ligne_ges = 62

End If

End If



ActiveSheet.Shapes.Range(Array("txt_curseur_ges")).TextFrame2.TextRange.Characters.Text = Format(ges, "#,##0")
ActiveSheet.Shapes.Range(Array("txt_curseur_ges")).Left = ActiveSheet.Range("K" & num_ligne_ges).Left
ActiveSheet.Shapes.Range(Array("txt_curseur_ges")).Top = ActiveSheet.Range("K" & num_ligne_ges).Top


ElseIf Target.Address = "$E$18" Then

ges = ActiveSheet.Range("E18")
num_ligne_ges = ActiveSheet.Range("E18")

If ges >= 0 Then

If ges >= 0 And num_ligne_ges <= 5 Then

num_ligne_ges = 56

ElseIf ges >= 6 And num_ligne_ges <= 10 Then

num_ligne_ges = 57

ElseIf ges >= 11 And num_ligne_ges <= 20 Then

num_ligne_ges = 58

ElseIf ges >= 21 And num_ligne_ges <= 35 Then

num_ligne_ges = 59

ElseIf ges >= 36 And num_ligne_ges <= 55 Then

num_ligne_ges = 60

ElseIf ges >= 56 And num_ligne_ges <= 80 Then

num_ligne_ges = 61

Else

num_ligne_ges = 62

End If

End If



ActiveSheet.Shapes.Range(Array("txt_curseur_ges_ini")).TextFrame2.TextRange.Characters.Text = Format(ges, "#,##0")
ActiveSheet.Shapes.Range(Array("txt_curseur_ges_ini")).Left = ActiveSheet.Range("L" & num_ligne_ges).Left
ActiveSheet.Shapes.Range(Array("txt_curseur_ges_ini")).Top = ActiveSheet.Range("L" & num_ligne_ges).Top


ElseIf Target.Address = "$E$16" Then


nrj = ActiveSheet.Range("E16")
num_ligne_nrj = ActiveSheet.Range("E16")

If nrj >= 0 Then

If nrj >= 0 And num_ligne_nrj <= 50 Then

num_ligne_nrj = 56

ElseIf nrj >= 51 And num_ligne_nrj <= 90 Then

num_ligne_nrj = 57

ElseIf nrj >= 91 And num_ligne_nrj <= 150 Then

num_ligne_nrj = 58

ElseIf nrj >= 151 And num_ligne_nrj <= 230 Then

num_ligne_nrj = 59

ElseIf nrj >= 231 And num_ligne_nrj <= 330 Then

num_ligne_nrj = 60

ElseIf nrj >= 331 And num_ligne_nrj <= 450 Then

num_ligne_nrj = 61

Else

num_ligne_nrj = 62

End If

End If



ActiveSheet.Shapes.Range(Array("txt_curseur_nrj_ini")).TextFrame2.TextRange.Characters.Text = Format(nrj, "#,##0")
ActiveSheet.Shapes.Range(Array("txt_curseur_nrj_ini")).Left = ActiveSheet.Range("F" & num_ligne_nrj).Left
ActiveSheet.Shapes.Range(Array("txt_curseur_nrj_ini")).Top = ActiveSheet.Range("F" & num_ligne_nrj).Top


ElseIf Target.Address = "$E$42" Then


nrj = ActiveSheet.Range("E42")
num_ligne_nrj = ActiveSheet.Range("E42")

If nrj >= 0 Then

If nrj >= 0 And num_ligne_nrj <= 50 Then

num_ligne_nrj = 56

ElseIf nrj >= 51 And num_ligne_nrj <= 90 Then

num_ligne_nrj = 57

ElseIf nrj >= 91 And num_ligne_nrj <= 150 Then

num_ligne_nrj = 58

ElseIf nrj >= 151 And num_ligne_nrj <= 230 Then

num_ligne_nrj = 59

ElseIf nrj >= 231 And num_ligne_nrj <= 330 Then

num_ligne_nrj = 60

ElseIf nrj >= 331 And num_ligne_nrj <= 450 Then

num_ligne_nrj = 61

Else

num_ligne_nrj = 62

End If

End If



ActiveSheet.Shapes.Range(Array("txt_curseur_nrj")).TextFrame2.TextRange.Characters.Text = Format(nrj, "#,##0")
ActiveSheet.Shapes.Range(Array("txt_curseur_nrj")).Left = ActiveSheet.Range("E" & num_ligne_nrj).Left
ActiveSheet.Shapes.Range(Array("txt_curseur_nrj")).Top = ActiveSheet.Range("E" & num_ligne_nrj).Top

Range("E42").Select

End If


End Sub
 

Statistiques des forums

Discussions
313 329
Messages
2 097 229
Membres
106 880
dernier inscrit
Michel2024