1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
| Option Explicit
'faire reference à : Microsoft ActiveX Data Objects 2.0 Library, msado20.tlb
'varibles pour manipulation de la base de données
Dim CheminDataBase As New ADODB.Connection
Dim TablES1 As New ADODB.Recordset
Dim CheminNomDelabase As String
Dim NomDeLaTable As String
'utilisation de la classe proposé par hpfx qui ce trouve ici
'http://www.developpez.net/forums/d608943/autres-langages/general-visual-basic-6-vbscript/vb-6-anterieur/vos-contributions-vb6/source-classe-prete-lemploi-tooltiptext-info-bulles/
Dim TT As CtoolTip
Dim EnCour As Boolean
Dim LeTitre As String, Infos As String
Private Sub Form_Load()
'***** à adapter ***************************************
CheminNomDelabase = "C:\PersoFrancis\BDpourEssais.mdb"
NomDeLaTable = "Principal"
'***** fini à adapter **********************************
EnCour = False
'chargement de la classe CtoolTip
Set TT = New CtoolTip
'configuration minimum
TT.DelayTime = 100 ' 1/10 sec pour afficher
TT.VisibleTime = 5000 ' reste affiché 5 sec
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If EnCour = True Then EnCour = False
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If EnCour = True Then Exit Sub
ChargeInfos
If LeTitre = "" Then Exit Sub
Call TT.Display(Command1.hwnd, LeTitre, Infos, TTIconInfo)
End Sub
Public Sub ChargeInfos()
Dim T As Integer
EnCour = True
LeTitre = "": Infos = ""
On Error Resume Next: CheminDataBase.Close: If Err.Number <> 0 Then On Error GoTo 0 Else On Error GoTo 0
CheminDataBase.CursorLocation = adUseClient: CheminDataBase.Mode = adModeReadWrite
On Error Resume Next
CheminDataBase.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source= " & CheminNomDelabase & ";"
If Err.Number <> 0 Then
On Error GoTo 0
Command1.ToolTipText = "Impossible d'ouvrir la base de données source."
Exit Sub
Else
On Error GoTo 0
End If
TablES1.Open NomDeLaTable, CheminDataBase, adOpenStatic, adLockPessimistic
If TablES1.EOF Then
Command1.ToolTipText = "Impossible de trouver la table ''" & NomDeLaTable & "'' dans la base de données source."
CheminDataBase.Close
Else
LeTitre = "ToolTipText de Command1"
For T = 1 To TablES1.RecordCount 'ou bien choix de X enregistrements
Infos = Infos & TablES1.Fields(6)
If T <> TablES1.RecordCount Then Infos = Infos & vbCrLf
TablES1.MoveNext: DoEvents
Next T
TablES1.Close: DoEvents
CheminDataBase.Close
End If
End Sub |
Partager