Objet "line" dans une userform

Signaler
Messages postés
3
Date d'inscription
mardi 17 juin 2008
Statut
Membre
Dernière intervention
18 juin 2008
-
Messages postés
492
Date d'inscription
jeudi 5 avril 2007
Statut
Membre
Dernière intervention
2 juillet 2012
-
Bonjour,

Voila une grosse galère pour moi, je cherche a faire un userform avec un affichage de tableau de bord type "compteur de voiture" ou "cockpit".

Problème, avec ma version vb6.3, je n'arrive pas à avoir dans la partie "controles supplémentaires" dans ma boite a outils l'objet "line" afin de créer l'aiguille du compteur.

J'ai pourtant fouillé la bibliothèque, il n'y a rien à faire.

Quelqu'un peut il m'aider??

Merci

Nicolas

5 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
70
Salut
VB 6.3 : Ce doit être du VBA ?
Tu travailles avec quel logiciel ? Excel, Word ou Access  ?

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
3
Date d'inscription
mardi 17 juin 2008
Statut
Membre
Dernière intervention
18 juin 2008

oui c'est bien du VBA.


je travaille sur excel


Merci de ton aide.
Messages postés
492
Date d'inscription
jeudi 5 avril 2007
Statut
Membre
Dernière intervention
2 juillet 2012
2
J'ai bien une solution mais c'est assez compliqué et ca fait appel aux API, si ca t'intéresse tu dit.
Messages postés
3
Date d'inscription
mardi 17 juin 2008
Statut
Membre
Dernière intervention
18 juin 2008

sans problème,
je suis interessé par toute solution,  je suis bloqué et il faut que j'avance...
merci
Messages postés
492
Date d'inscription
jeudi 5 avril 2007
Statut
Membre
Dernière intervention
2 juillet 2012
2
Pour le test ouvre un nouveau classeur et ajouter un UF

'Mode d'emploi...
'dans le module de feuille mettre
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'    'activer un UC et dessiner dessus (trouver sont HDC)
'    UserForm1.Show
'End Sub

'2 modes, si la nouvelle sélection est A1 ou pas
'Sur la feuille sélectionner B1 pour mode 1
'Trace une ligne en suivant le déplacement de la souris.
'Sélectionner A1 pour mode 2
'Trace une ligne à partir d'un point central jusqu'a la position souris.
'Et efface la ligne précedante.


'Dans le module de l'UF1 mettre.....
Const PS_SOLID = 0
Private Type POINTAPI
  X As Long
  Y As Long
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, _
  ByVal X As Long, ByVal Y As Long, lpPoint As Any) As Long


Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Byte
Private monhdc As Long
Dim Buff As Boolean
Dim TimeOnOFF As Boolean
Dim CurX As Integer, CurY As Integer
Dim ModeLigne As Boolean
Dim coul As Long


Private Sub UserForm_Activate()
    If ActiveCell.Address = "$A$1" Then
        CurX = Me.Width / 2
        CurY = Me.Height / 2
        coul = &H80C0FF
        Me.BackColor = coul
        ModeLigne = True
    End If
End Sub


Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Buff = True
End Sub


Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Not ModeLigne Then
        Do While monhdc = 0
            monhdc = GetForegroundWindow()
            monhdc = GetDC(monhdc)
        Loop
        If Button <> 1 Then Exit Sub
        hRPen = CreatePen(PS_SOLID, 10, RGB(0, 255, 0))
        DeleteObject SelectObject(monhdc, hRPen)
        If Buff Then
            MoveToEx monhdc, X * 1.32, Y * 1.32, &H0
            Buff = False
        End If
        LineTo monhdc, X * 1.32, Y * 1.32
        DoEvents
    End If
End Sub




Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Static MX As Integer
Static MY As Integer
   
    If ModeLigne Then
        Do While monhdc = 0
            monhdc = GetForegroundWindow()
            monhdc = GetDC(monhdc)
        Loop
        If MX > 0 Then
            hRPen = CreatePen(PS_SOLID, 10, coul)
            DeleteObject SelectObject(monhdc, hRPen)
            MoveToEx monhdc, CurX * 1.32, CurY * 1.32, &H0
            LineTo monhdc, MX * 1.32, MY * 1.32
        End If
        hRPen = CreatePen(PS_SOLID, 6, RGB(0, 255, 0))
        DeleteObject SelectObject(monhdc, hRPen)
        MoveToEx monhdc, CurX * 1.32, CurY * 1.32, &H0
        LineTo monhdc, X * 1.32, Y * 1.32
    End If    MX X: MY Y
End Sub

A toi de voir pour sélectionner les points X et Y
A+