Problème code VBA jauge verticale

Problème code VBA jauge verticale - VB/VBA/VBS - Programmation

Marsh Posté le 08-05-2008 à 16:28:47    

Bonjour,
 
Je dois réaliser une jauge verticale pour un tableau de bord.
J'ai le code vba de l'ouvrage d'Alain Fernandez (l'essentiel du tableau de bord) mais je voudrais le modifier mais je n'y arrive pas.
 
Ce que je voudrais :
- avoir une cellule valeur qui permet de mettre à jour la jauge à la place d'un scrollbar
- mettre la jauge dans la feuil2 par exemple et les données dans la feuil1
 
Merci par avance
 

Code :
  1. Private Sub ScrollBar1_Change()
  2. seuilbas = Range("J6" ).Value    'lit la valeur du seuil bas en H12
  3. seuilhaut = Range("J7" ).Value   'lit la valeur du seuil haut en H13
  4. objectif = Range("J8" ).Value   'lit la valeur de l'objectif
  5. Call jaugeV(seuilbas, seuilhaut, ScrollBar1.Value, objectif)
  7. End Sub
  9. '****************************
  10. ' jauge vertical avec seuils
  11. ' 4 arguments d'entrée : les seuils, la mesure et l'objectif
  12. '****************************
  13. ' La couleur rouge "danger" est définie en deça du seuil bas.
  14. ' Pour la positionner au dessus du seuil haut inverser avec la couleur verte
  15. Sub jaugeV(seuilbas, seuilhaut, mesure, objectif)
  16. Max = 100 ' Affichage en %
  17. If seuilhaut > Max Then seuilhaut = Max  'prévient les erreurs
  18. If seuilbas > Max Then seuilbas = Max ' ""
  19. If mesure > Max Then mesure = Max ' ""
  20. mercure1.Height = (Tube1.Height / Max * mesure) ' Calcul la hauteur de mercure
  21. mercure1.Top = Tube1.Top + Tube1.Height - mercure1.Height - 1
  22. limite1.Height = (Tube1.Height / Max * objectif) ' Calcul la hauteur de l'indicateur d'objectif
  23. limite1.Top = Tube1.Top + Tube1.Height - limite1.Height - 1
  24. If mesure < seuilbas Then mercure1.BackColor = RGB(255, 0, 0)  'affiche en rouge (passer en vert le cas échéant)
  25. If mesure >= seuilbas And mesure < seuilhaut Then mercure1.BackColor = RGB(250, 250, 0) 'affiche en jaune
  26. If mesure >= seuilhaut Then mercure1.BackColor = RGB(0, 255, 0) 'affiche en vert (passer en rouge le cas échéant)
  27. mesure1.Caption = mesure  'affiche la valeur de la mesure
  28. If mesure >= objectif Then
  29.     mesure1.Font.Bold = True  'l'objectif est atteint, affiche la valeur en gras
  30.     mesure1.Font.Size = 12
  31. Else
  32.     mesure1.Font.Bold = False
  33.     mesure1.Font.Size = 10
  34. End If
  35. objectif1.Caption = objectif
  37. End Sub


Message édité par nichboul le 08-05-2008 à 16:31:41
Reply

Marsh Posté le 08-05-2008 à 16:28:47   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed