Besoin de suggestions de code
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
-
29 avril 2008 à 08:07
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 5 mai 2008 à 13:14
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 5 mai 2008 à 13:14
31 réponses
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
29 avril 2008 à 16:12
29 avril 2008 à 16:12
Re :
Pour l'instant :
Module :
Option Explicit
Public sSql As String ' chaine pour définir la requête
Public oCnxAdo As New ADODB.Connection ' Object de connection à la bdd
Public oRstAdo As New ADODB.Recordset ' object recordset
Public sCheminBase As String ' Donne le chemin de la base à ma variable
Public Function OpenDataBase() As Boolean
' ***********************************
' Function d'ouverture bdd
' avec retour en Boolean si Ok (True)
' ***********************************
' On la ferme avant, çà évite parfois des surprises. exe : elle est déjà ouverte donc erreur?
Call CloseDataBase
' Choix du fournisseur ,ouverture Base de Données
oCnxAdo.Provider = "Microsoft.jet.OLEDB.4.0"
' Prend le chemin de la base
SetDataBasePath
' Donne le chemin pour la connection
oCnxAdo.ConnectionString = sCheminBase
' Gestion erreur s'il y a
On Error Resume Next
' Ouvre la connection avec la base
oCnxAdo.Open
' là on traite l'erreur, avec résultat en conséquence OpenDataBase (Err.Number 0)
If Err.Number Then Err.Clear ' si erreur, nettoie le gestionnaire d'erreur
End Function
Private Sub SetDataBasePath()
' Récupère le chemin
sCheminBase = App.Path
' ajoute le slash s'il faut ! If Not (LeftB$(sCheminBase, 2) "") Then sCheminBase sCheminBase & ""
' Chemin définitif
sCheminBase = sCheminBase & "Bd1.mdb"
End Sub
Public Sub CloseDataBase()
On Error Resume Next 'au cas où !
' Libération ressource
oRstAdo.Cancel
oRstAdo.Close
Set oRstAdo = Nothing
oCnxAdo.Cancel
oCnxAdo.Close
Set oCnxAdo = Nothing
' Nettoie car de toute façon, il y aura une erreur au
' premier lancement sur le oRstAdo
Err.Clear
End Sub
Public Function Execute_Sql() As Boolean
' **************************************
' Fonction qui exécute la requête
' Remplis le Recordset
' Et retour résultat du bon déroulement
' **************************************
' on premier, on ferme le dernier enreg
On Error Resume Next
oRstAdo.Cancel
oRstAdo.Close
' erreur ou pas, pas besoin de tester
Err.Clear
' Execution requête avec paramètre recordset via oCnxAdo
oRstAdo.CursorLocation = adUseClient
oRstAdo.Open sSql, oCnxAdo, adOpenDynamic, adLockPessimistic
' on est toujours sous la gestion d'erreur Execute_Sql (Err.Number 0)
If Err.Number Then Err.Clear
End Function
Public Function AddColLvi(ByRef oCnxAdo As ADODB.Connection, oLv As ListView, ByVal sSql As String, Optional ByVal bHeader As Boolean True, Optional ByVal lFirstRow As Long 1, Optional ByVal lLastRow As Long = 0) As Boolean
'*****************************************************************************
'* Auteur : PCPT >> Www.Vbfrance.com *
'* *
'* Fonction remplissage de colonnes (headers / nom des tables) et des *
'* champs avec "LIMIT" définissable dans ListView à partir *
'* d'une Connexion ADO active *
'* *
'* ----------------------- *
'* -Ajout Référence projet : Microsoft ActiveX Data Objects 2.5 Library *
'* -Ajout composant : Microsoft Windows Common controls 6.0 *
'* ----------------------- *
'* *
'* ------------ *
'* Utilisation : *
'* ------------ *
'* les 5 premiers : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 1, 5 *
' *
'* les 5 seconds : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 6, 10 *
' *
'* du 11è à la fin : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 11, 0 *
' *
'* tous sans Header : *
'* ListView1.ColumnHeaders.Add , , "champs 1" *
'* ListView1.ColumnHeaders.Add , , "champs 2" *
'* AddColLvi oCnxAdo, ListView1, sSql, False *
' *
'*****************************************************************************
' init function
AddColLvi = False
' Recordset
On Error Resume Next
oRstAdo.Cancel
oRstAdo.Close
Set oRstAdo = Nothing
Err.Clear
' cnx inexistante?
If oCnxAdo Is Nothing Then
Exit Function
ElseIf Not (oCnxAdo.State = adStateOpen) Then
Exit Function
End If
' sSql vide?
sSql = Trim$(sSql)
If LenB(sSql) = 0 Then Exit Function
' logique rows
If lFirstRow < 0 Then
Exit Function
ElseIf lLastRow < 0 Then
Exit Function
ElseIf (lLastRow > 0) And (lLastRow < lFirstRow) Then
Exit Function
End If
' variables
Dim i As Long
Dim j As Long
Dim Itmx As ListItem
' init Listview
If bHeader Then oLv.ListItems.Clear: oLv.ColumnHeaders.Clear
oLv.Visible = False
' quitte si erreurs
On Error GoTo Lbl_Err
' Paramètres RecordSet et lancement de la requête
oRstAdo.CursorLocation = adUseClient
oRstAdo.Open sSql, oCnxAdo, adOpenDynamic, adLockPessimistic
' Si il n'y a pas de champs on ne fait rien
If oRstAdo.Fields.Count > 0 Then
' header
If bHeader Then
' on affiche forcément toutes les colonnes puisque c'est la requête qui prévoit le retour
For i = 0 To oRstAdo.Fields.Count - 1
oLv.ColumnHeaders.Add , , oRstAdo.Fields(i).Name
Next i
End If
' champs. attention!! si pas de header, il faut évidemment que la listview ait été préparée avant!
If oRstAdo.RecordCount > 0 Then
' 1er champ zéro = aucun champs
If lFirstRow > 0 Then ' dernier champ zéro tous, trop grand> on réduit au dernier If (lLastRow 0) Or (lLastRow > oRstAdo.RecordCount) Then lLastRow oRstAdo.RecordCount
' ajoute
oRstAdo.Move lFirstRow - 1
For i = lFirstRow - 1 To lLastRow - 1
Set Itmx = oLv.ListItems.Add(, , CStr(oRstAdo.Fields(0).Value))
For j = 1 To oRstAdo.Fields.Count - 1
Itmx.SubItems(j) = IIf(LenB(oRstAdo.Fields(j).Value) > 0, oRstAdo.Fields(j).Value, vbNullString)
Next j
' passe à l'enregistrement suivant
If Not oRstAdo.EOF Then oRstAdo.MoveNext
Next i
' Pas d'erreur
AddColLvi = True
Else
' pas de champs mais pas d'erreur pour autant
AddColLvi = True
End If
Else
' Pas d'erreur
AddColLvi = True
End If
End If
' gestion d'erreur s'il y en a eu
Lbl_Err:
If Not (Err.Number = 0) Then
AddColLvi = False
Err.Clear
End If
oLv.Visible = True
' libération objet
Set Itmx = Nothing
End Function
Public Sub ResizeLv(oFrm As Form, oLv As ListView)
'**************************************************************************/
' Sub qui ajuste mes colonnes à mes Listview's /
'**************************************************************************/
' By Jack >> Www.Vbfrance.com
' On va régler la largeur des colonnes en fonction du contenu
Dim r As Integer, t As Long, Largeur As Long, Max As Long
' init Listview
oLv.Visible = False
' 1ere colonne (n'est pas une SubItem)
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(1).Text)
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).Text)
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(1).Width = Max * 2.3
For r = 2 To oLv.ColumnHeaders.Count
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(r).Text)
' Ensuite, le test de ttes les données
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).SubItems(r - 1))
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(r).Width = Max * 2.3
Next r
' init Listview
oLv.Visible = True
End Sub
Public Sub ResizeCcLst(oFrm As Form, oLv As ListView)
'**************************************************************************/
' Sub qui ajuste mes colonnes à mes Listview's /
'**************************************************************************/
' By Jack >> Www.Vbfrance.com
' On va régler la largeur des colonnes en fonction du contenu
Dim r As Integer, t As Long, Largeur As Long, Max As Long
' init Listview
oLv.Visible = False
' 1ere colonne (n'est pas une SubItem)
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(1).Text)
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).Text)
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(1).Width = Max * 2.3
For r = 2 To oLv.ColumnHeaders.Count
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(r).Text)
' Ensuite, le test de ttes les données
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).SubItems(r - 1))
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(r).Width = Max * 2.3
Next r
' init Listview
oLv.Visible = True
End Sub
Form1 :
Option Explicit
Private Sub CcBtnClient_Click()
' Affiche From2
Form2.Show (vbModal)
End Sub
Private Sub Command1_Click()
' Quitte / ferme la base et décharge Form1
CloseDataBase
End
End Sub
Private Sub Form_Load()
' Demande la connection à la base
If Not OpenDataBase Then MsgBox "Erreur...connection impossible !", vbExclamation Or vbOKOnly, "Erreur de connection": Unload Me
' Remplissage de Listview(Form2)
If AddColLvi(oCnxAdo, Form2.CcLst, "Select * From Clients") Then
' Affiche dans (CcLst)
Form2.CcLst.View = lvwReport
Form2.CcLst.Font.Size = 10
Form2.CcLst.Sorted = False
' Rsize des colonnes Listview
ResizeCcLst Form2, Form2.CcLst
End If
End Sub
Bon, c'est le début....le reste plus tard ce soir...lol...
A+
Exploreur
Linux a un noyau, Windows un pépin
Pour l'instant :
Module :
Option Explicit
Public sSql As String ' chaine pour définir la requête
Public oCnxAdo As New ADODB.Connection ' Object de connection à la bdd
Public oRstAdo As New ADODB.Recordset ' object recordset
Public sCheminBase As String ' Donne le chemin de la base à ma variable
Public Function OpenDataBase() As Boolean
' ***********************************
' Function d'ouverture bdd
' avec retour en Boolean si Ok (True)
' ***********************************
' On la ferme avant, çà évite parfois des surprises. exe : elle est déjà ouverte donc erreur?
Call CloseDataBase
' Choix du fournisseur ,ouverture Base de Données
oCnxAdo.Provider = "Microsoft.jet.OLEDB.4.0"
' Prend le chemin de la base
SetDataBasePath
' Donne le chemin pour la connection
oCnxAdo.ConnectionString = sCheminBase
' Gestion erreur s'il y a
On Error Resume Next
' Ouvre la connection avec la base
oCnxAdo.Open
' là on traite l'erreur, avec résultat en conséquence OpenDataBase (Err.Number 0)
If Err.Number Then Err.Clear ' si erreur, nettoie le gestionnaire d'erreur
End Function
Private Sub SetDataBasePath()
' Récupère le chemin
sCheminBase = App.Path
' ajoute le slash s'il faut ! If Not (LeftB$(sCheminBase, 2) "") Then sCheminBase sCheminBase & ""
' Chemin définitif
sCheminBase = sCheminBase & "Bd1.mdb"
End Sub
Public Sub CloseDataBase()
On Error Resume Next 'au cas où !
' Libération ressource
oRstAdo.Cancel
oRstAdo.Close
Set oRstAdo = Nothing
oCnxAdo.Cancel
oCnxAdo.Close
Set oCnxAdo = Nothing
' Nettoie car de toute façon, il y aura une erreur au
' premier lancement sur le oRstAdo
Err.Clear
End Sub
Public Function Execute_Sql() As Boolean
' **************************************
' Fonction qui exécute la requête
' Remplis le Recordset
' Et retour résultat du bon déroulement
' **************************************
' on premier, on ferme le dernier enreg
On Error Resume Next
oRstAdo.Cancel
oRstAdo.Close
' erreur ou pas, pas besoin de tester
Err.Clear
' Execution requête avec paramètre recordset via oCnxAdo
oRstAdo.CursorLocation = adUseClient
oRstAdo.Open sSql, oCnxAdo, adOpenDynamic, adLockPessimistic
' on est toujours sous la gestion d'erreur Execute_Sql (Err.Number 0)
If Err.Number Then Err.Clear
End Function
Public Function AddColLvi(ByRef oCnxAdo As ADODB.Connection, oLv As ListView, ByVal sSql As String, Optional ByVal bHeader As Boolean True, Optional ByVal lFirstRow As Long 1, Optional ByVal lLastRow As Long = 0) As Boolean
'*****************************************************************************
'* Auteur : PCPT >> Www.Vbfrance.com *
'* *
'* Fonction remplissage de colonnes (headers / nom des tables) et des *
'* champs avec "LIMIT" définissable dans ListView à partir *
'* d'une Connexion ADO active *
'* *
'* ----------------------- *
'* -Ajout Référence projet : Microsoft ActiveX Data Objects 2.5 Library *
'* -Ajout composant : Microsoft Windows Common controls 6.0 *
'* ----------------------- *
'* *
'* ------------ *
'* Utilisation : *
'* ------------ *
'* les 5 premiers : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 1, 5 *
' *
'* les 5 seconds : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 6, 10 *
' *
'* du 11è à la fin : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 11, 0 *
' *
'* tous sans Header : *
'* ListView1.ColumnHeaders.Add , , "champs 1" *
'* ListView1.ColumnHeaders.Add , , "champs 2" *
'* AddColLvi oCnxAdo, ListView1, sSql, False *
' *
'*****************************************************************************
' init function
AddColLvi = False
' Recordset
On Error Resume Next
oRstAdo.Cancel
oRstAdo.Close
Set oRstAdo = Nothing
Err.Clear
' cnx inexistante?
If oCnxAdo Is Nothing Then
Exit Function
ElseIf Not (oCnxAdo.State = adStateOpen) Then
Exit Function
End If
' sSql vide?
sSql = Trim$(sSql)
If LenB(sSql) = 0 Then Exit Function
' logique rows
If lFirstRow < 0 Then
Exit Function
ElseIf lLastRow < 0 Then
Exit Function
ElseIf (lLastRow > 0) And (lLastRow < lFirstRow) Then
Exit Function
End If
' variables
Dim i As Long
Dim j As Long
Dim Itmx As ListItem
' init Listview
If bHeader Then oLv.ListItems.Clear: oLv.ColumnHeaders.Clear
oLv.Visible = False
' quitte si erreurs
On Error GoTo Lbl_Err
' Paramètres RecordSet et lancement de la requête
oRstAdo.CursorLocation = adUseClient
oRstAdo.Open sSql, oCnxAdo, adOpenDynamic, adLockPessimistic
' Si il n'y a pas de champs on ne fait rien
If oRstAdo.Fields.Count > 0 Then
' header
If bHeader Then
' on affiche forcément toutes les colonnes puisque c'est la requête qui prévoit le retour
For i = 0 To oRstAdo.Fields.Count - 1
oLv.ColumnHeaders.Add , , oRstAdo.Fields(i).Name
Next i
End If
' champs. attention!! si pas de header, il faut évidemment que la listview ait été préparée avant!
If oRstAdo.RecordCount > 0 Then
' 1er champ zéro = aucun champs
If lFirstRow > 0 Then ' dernier champ zéro tous, trop grand> on réduit au dernier If (lLastRow 0) Or (lLastRow > oRstAdo.RecordCount) Then lLastRow oRstAdo.RecordCount
' ajoute
oRstAdo.Move lFirstRow - 1
For i = lFirstRow - 1 To lLastRow - 1
Set Itmx = oLv.ListItems.Add(, , CStr(oRstAdo.Fields(0).Value))
For j = 1 To oRstAdo.Fields.Count - 1
Itmx.SubItems(j) = IIf(LenB(oRstAdo.Fields(j).Value) > 0, oRstAdo.Fields(j).Value, vbNullString)
Next j
' passe à l'enregistrement suivant
If Not oRstAdo.EOF Then oRstAdo.MoveNext
Next i
' Pas d'erreur
AddColLvi = True
Else
' pas de champs mais pas d'erreur pour autant
AddColLvi = True
End If
Else
' Pas d'erreur
AddColLvi = True
End If
End If
' gestion d'erreur s'il y en a eu
Lbl_Err:
If Not (Err.Number = 0) Then
AddColLvi = False
Err.Clear
End If
oLv.Visible = True
' libération objet
Set Itmx = Nothing
End Function
Public Sub ResizeLv(oFrm As Form, oLv As ListView)
'**************************************************************************/
' Sub qui ajuste mes colonnes à mes Listview's /
'**************************************************************************/
' By Jack >> Www.Vbfrance.com
' On va régler la largeur des colonnes en fonction du contenu
Dim r As Integer, t As Long, Largeur As Long, Max As Long
' init Listview
oLv.Visible = False
' 1ere colonne (n'est pas une SubItem)
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(1).Text)
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).Text)
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(1).Width = Max * 2.3
For r = 2 To oLv.ColumnHeaders.Count
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(r).Text)
' Ensuite, le test de ttes les données
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).SubItems(r - 1))
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(r).Width = Max * 2.3
Next r
' init Listview
oLv.Visible = True
End Sub
Public Sub ResizeCcLst(oFrm As Form, oLv As ListView)
'**************************************************************************/
' Sub qui ajuste mes colonnes à mes Listview's /
'**************************************************************************/
' By Jack >> Www.Vbfrance.com
' On va régler la largeur des colonnes en fonction du contenu
Dim r As Integer, t As Long, Largeur As Long, Max As Long
' init Listview
oLv.Visible = False
' 1ere colonne (n'est pas une SubItem)
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(1).Text)
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).Text)
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(1).Width = Max * 2.3
For r = 2 To oLv.ColumnHeaders.Count
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(r).Text)
' Ensuite, le test de ttes les données
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).SubItems(r - 1))
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(r).Width = Max * 2.3
Next r
' init Listview
oLv.Visible = True
End Sub
Form1 :
Option Explicit
Private Sub CcBtnClient_Click()
' Affiche From2
Form2.Show (vbModal)
End Sub
Private Sub Command1_Click()
' Quitte / ferme la base et décharge Form1
CloseDataBase
End
End Sub
Private Sub Form_Load()
' Demande la connection à la base
If Not OpenDataBase Then MsgBox "Erreur...connection impossible !", vbExclamation Or vbOKOnly, "Erreur de connection": Unload Me
' Remplissage de Listview(Form2)
If AddColLvi(oCnxAdo, Form2.CcLst, "Select * From Clients") Then
' Affiche dans (CcLst)
Form2.CcLst.View = lvwReport
Form2.CcLst.Font.Size = 10
Form2.CcLst.Sorted = False
' Rsize des colonnes Listview
ResizeCcLst Form2, Form2.CcLst
End If
End Sub
Bon, c'est le début....le reste plus tard ce soir...lol...
A+
Exploreur
Linux a un noyau, Windows un pépin
Polack77
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
29 avril 2008 à 16:24
29 avril 2008 à 16:24
Je ne suis pas tout seul à ne pas savoir faire les chose à moité dirait-on (et je ne suis pas le pire moi j'ai pas codé, trop fainéant, et vue que tu m'a dit que ce n'est pas vraiment ce que tu attendais)
Tu voulais des suggestions et te voila bientôt avec des programmes tout fait.
PS :
En même temps si tu ne passais pas ton temps à aidé tout le monde il y aurais moins de chance que ce genre de chose arrive...
Tu ne peut t'en prendre qu'à toi
LOL
(Bon maintenant trêve de conneries apprêt tout ce forum n'est pas là pour sa)
Amicalement
Pensez "Réponse acceptée"
Tu voulais des suggestions et te voila bientôt avec des programmes tout fait.
PS :
En même temps si tu ne passais pas ton temps à aidé tout le monde il y aurais moins de chance que ce genre de chose arrive...
Tu ne peut t'en prendre qu'à toi
LOL
(Bon maintenant trêve de conneries apprêt tout ce forum n'est pas là pour sa)
Amicalement
Pensez "Réponse acceptée"
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
29 avril 2008 à 17:25
29 avril 2008 à 17:25
Re,
Bon suite et fin avec quelques modifes :
Module :
Option Explicit
Public sSql As String ' chaine pour définir la requête
Public sNom As String ' Garde le choix de la personne
Public oCnxAdo As New ADODB.Connection ' Object de connection à la bdd
Public oRstAdo As New ADODB.Recordset ' object recordset
Public sCheminBase As String ' Donne le chemin de la base à ma variable
Public Function OpenDataBase() As Boolean
' ***********************************
' Function d'ouverture bdd
' avec retour en Boolean si Ok (True)
' ***********************************
' On la ferme avant, çà évite parfois des surprises. exe : elle est déjà ouverte donc erreur?
Call CloseDataBase
' Choix du fournisseur ,ouverture Base de Données
oCnxAdo.Provider = "Microsoft.jet.OLEDB.4.0"
' Prend le chemin de la base
SetDataBasePath
' Donne le chemin pour la connection
oCnxAdo.ConnectionString = sCheminBase
' Gestion erreur s'il y a
On Error Resume Next
' Ouvre la connection avec la base
oCnxAdo.Open
' là on traite l'erreur, avec résultat en conséquence OpenDataBase (Err.Number 0)
If Err.Number Then Err.Clear ' si erreur, nettoie le gestionnaire d'erreur
End Function
Private Sub SetDataBasePath()
' Récupère le chemin
sCheminBase = App.Path
' ajoute le slash s'il faut ! If Not (LeftB$(sCheminBase, 2) "") Then sCheminBase sCheminBase & ""
' Chemin définitif
sCheminBase = sCheminBase & "Bd1.mdb"
End Sub
Public Sub CloseDataBase()
On Error Resume Next 'au cas où
' Libération ressource
oRstAdo.Cancel
oRstAdo.Close
Set oRstAdo = Nothing
oCnxAdo.Cancel
oCnxAdo.Close
Set oCnxAdo = Nothing
' Nettoie car de toute façon, il y aura une erreur au
' premier lancement sur le oRstAdo
Err.Clear
End Sub
Public Function AddColLvi(ByRef oCnxAdo As ADODB.Connection, oLv As ListView, ByVal sSql As String, Optional ByVal bHeader As Boolean True, Optional ByVal lFirstRow As Long 1, Optional ByVal lLastRow As Long = 0) As Boolean
'*****************************************************************************
'* Auteur : PCPT >> Www.Vbfrance.com *
'* *
'* Fonction remplissage de colonnes (headers / nom des tables) et des *
'* champs avec "LIMIT" définissable dans ListView à partir *
'* d'une Connexion ADO active *
'* *
'* ----------------------- *
'* -Ajout Référence projet : Microsoft ActiveX Data Objects 2.5 Library *
'* -Ajout composant : Microsoft Windows Common controls 6.0 *
'* ----------------------- *
'* *
'* ------------ *
'* Utilisation : *
'* ------------ *
'* les 5 premiers : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 1, 5 *
' *
'* les 5 seconds : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 6, 10 *
' *
'* du 11è à la fin : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 11, 0 *
' *
'* tous sans Header : *
'* ListView1.ColumnHeaders.Add , , "champs 1" *
'* ListView1.ColumnHeaders.Add , , "champs 2" *
'* AddColLvi oCnxAdo, ListView1, sSql, False *
' *
'*****************************************************************************
' init function
AddColLvi = False
' Recordset
On Error Resume Next
oRstAdo.Cancel
oRstAdo.Close
Set oRstAdo = Nothing
Err.Clear
' cnx inexistante?
If oCnxAdo Is Nothing Then
Exit Function
ElseIf Not (oCnxAdo.State = adStateOpen) Then
Exit Function
End If
' sSql vide?
sSql = Trim$(sSql)
If LenB(sSql) = 0 Then Exit Function
' logique rows
If lFirstRow < 0 Then
Exit Function
ElseIf lLastRow < 0 Then
Exit Function
ElseIf (lLastRow > 0) And (lLastRow < lFirstRow) Then
Exit Function
End If
' variables
Dim i As Long
Dim j As Long
Dim Itmx As ListItem
' init Listview
If bHeader Then oLv.ListItems.Clear: oLv.ColumnHeaders.Clear
oLv.Visible = False
' quitte si erreurs
On Error GoTo Lbl_Err
' Paramètres RecordSet et lancement de la requête
oRstAdo.CursorLocation = adUseClient
oRstAdo.Open sSql, oCnxAdo, adOpenDynamic, adLockPessimistic
' Si il n'y a pas de champs on ne fait rien
If oRstAdo.Fields.Count > 0 Then
' header
If bHeader Then
' on affiche forcément toutes les colonnes puisque c'est la requête qui prévoit le retour
For i = 0 To oRstAdo.Fields.Count - 1
oLv.ColumnHeaders.Add , , oRstAdo.Fields(i).Name
Next i
End If
' champs. attention!! si pas de header, il faut évidemment que la listview ait été préparée avant!
If oRstAdo.RecordCount > 0 Then
' 1er champ zéro = aucun champs
If lFirstRow > 0 Then ' dernier champ zéro tous, trop grand> on réduit au dernier If (lLastRow 0) Or (lLastRow > oRstAdo.RecordCount) Then lLastRow oRstAdo.RecordCount
' ajoute
oRstAdo.Move lFirstRow - 1
For i = lFirstRow - 1 To lLastRow - 1
Set Itmx = oLv.ListItems.Add(, , CStr(oRstAdo.Fields(0).Value))
For j = 1 To oRstAdo.Fields.Count - 1
Itmx.SubItems(j) = IIf(LenB(oRstAdo.Fields(j).Value) > 0, oRstAdo.Fields(j).Value, vbNullString)
Next j
' passe à l'enregistrement suivant
If Not oRstAdo.EOF Then oRstAdo.MoveNext
Next i
' Pas d'erreur
AddColLvi = True
Else
' pas de champs mais pas d'erreur pour autant
AddColLvi = True
End If
Else
' Pas d'erreur
AddColLvi = True
End If
End If
' gestion d'erreur s'il y en a eu
Lbl_Err:
If Not (Err.Number = 0) Then
AddColLvi = False
Err.Clear
End If
oLv.Visible = True
' libération objet
Set Itmx = Nothing
End Function
Public Sub ResizeLv(oFrm As Form, oLv As ListView)
'**************************************************************************/
' Sub qui ajuste mes colonnes à mes Listview's /
'**************************************************************************/
' By Jack >> Www.Vbfrance.com
' On va régler la largeur des colonnes en fonction du contenu
Dim r As Integer, t As Long, Largeur As Long, Max As Long
' init Listview
oLv.Visible = False
' 1ere colonne (n'est pas une SubItem)
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(1).Text)
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).Text)
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(1).Width = Max * 2.3
For r = 2 To oLv.ColumnHeaders.Count
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(r).Text)
' Ensuite, le test de ttes les données
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).SubItems(r - 1))
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(r).Width = Max * 2.3
Next r
' init Listview
oLv.Visible = True
End Sub
Public Sub ResizeCcLst(oFrm As Form, oLv As ListView)
'**************************************************************************/
' Sub qui ajuste mes colonnes à mes Listview's /
'**************************************************************************/
' By Jack >> Www.Vbfrance.com
' On va régler la largeur des colonnes en fonction du contenu
Dim r As Integer, t As Long, Largeur As Long, Max As Long
' init Listview
oLv.Visible = False
' 1ere colonne (n'est pas une SubItem)
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(1).Text)
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).Text)
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(1).Width = Max * 2.3
For r = 2 To oLv.ColumnHeaders.Count
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(r).Text)
' Ensuite, le test de ttes les données
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).SubItems(r - 1))
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(r).Width = Max * 2.3
Next r
' init Listview
oLv.Visible = True
End Sub
Public Sub ChargeLV(oFrm As Form, oLv As ListView)
' Remplissage de Listview(Form2)
If AddColLvi(oCnxAdo, oLv, "Select * From Clients") Then
' Affiche dans (CcLst)
oLv.View = lvwReport
oLv.Font.Size = 10
oLv.Sorted = False
' Rsize des colonnes Listview
ResizeCcLst oFrm, oLv
End If
End Sub
Form1 :
Option Explicit
Private Sub CcBtnClient_Click()
' Remplissage de Listview(Form2)
ChargeLV Form2, Form2.CcLst
' Affiche From2
Form2.Show (vbModal)
End Sub
Private Sub Command1_Click()
' Quitte / ferme la base et décharge Form1
CloseDataBase
Unload Me
End Sub
Private Sub Form_Load()
' Demande la connection à la base
If Not OpenDataBase Then MsgBox "Erreur...connection impossible !", vbExclamation Or vbOKOnly, "Erreur de connection": Unload Me
' Remplissage de Listview(Form2)
ChargeLV Form2, Form2.CcLst
End Sub
Form2 :
Option Explicit
Private Sub CcBtnCancel_Click()
' Retour sur Form1 par défaut
' et décharge Form2
Unload Me
End Sub
Private Sub CcLst_ItemClick(ByVal ItemValide As ListItem)
' Variable de travail
Dim lIndex As Long
Dim lPos As Long
' Récupération de l'index
lIndex = ItemValide.Index
' Récupère l'id et la position dans la ListView
lPos = CLng(CcLst.ListItems(lIndex).Text)
' Affichage dans Form1
Form1.Text1(0).Text = CcLst.ListItems(lIndex).Text
Form1.Text1(1).Text = CcLst.ListItems(lIndex).SubItems(1)
Form1.Text1(2).Text = CcLst.ListItems(lIndex).SubItems(2)
Form1.Text1(3).Text = CcLst.ListItems(lIndex).SubItems(3)
Form1.CcTxtClient.Text = CcLst.ListItems(lIndex).Text
Unload Me
End Sub
Note : Par le click dans Listview, plus besoin à mon sens du bouton "OK"
A+
Exploreur
Linux a un noyau, Windows un pépin
Bon suite et fin avec quelques modifes :
Module :
Option Explicit
Public sSql As String ' chaine pour définir la requête
Public sNom As String ' Garde le choix de la personne
Public oCnxAdo As New ADODB.Connection ' Object de connection à la bdd
Public oRstAdo As New ADODB.Recordset ' object recordset
Public sCheminBase As String ' Donne le chemin de la base à ma variable
Public Function OpenDataBase() As Boolean
' ***********************************
' Function d'ouverture bdd
' avec retour en Boolean si Ok (True)
' ***********************************
' On la ferme avant, çà évite parfois des surprises. exe : elle est déjà ouverte donc erreur?
Call CloseDataBase
' Choix du fournisseur ,ouverture Base de Données
oCnxAdo.Provider = "Microsoft.jet.OLEDB.4.0"
' Prend le chemin de la base
SetDataBasePath
' Donne le chemin pour la connection
oCnxAdo.ConnectionString = sCheminBase
' Gestion erreur s'il y a
On Error Resume Next
' Ouvre la connection avec la base
oCnxAdo.Open
' là on traite l'erreur, avec résultat en conséquence OpenDataBase (Err.Number 0)
If Err.Number Then Err.Clear ' si erreur, nettoie le gestionnaire d'erreur
End Function
Private Sub SetDataBasePath()
' Récupère le chemin
sCheminBase = App.Path
' ajoute le slash s'il faut ! If Not (LeftB$(sCheminBase, 2) "") Then sCheminBase sCheminBase & ""
' Chemin définitif
sCheminBase = sCheminBase & "Bd1.mdb"
End Sub
Public Sub CloseDataBase()
On Error Resume Next 'au cas où
' Libération ressource
oRstAdo.Cancel
oRstAdo.Close
Set oRstAdo = Nothing
oCnxAdo.Cancel
oCnxAdo.Close
Set oCnxAdo = Nothing
' Nettoie car de toute façon, il y aura une erreur au
' premier lancement sur le oRstAdo
Err.Clear
End Sub
Public Function AddColLvi(ByRef oCnxAdo As ADODB.Connection, oLv As ListView, ByVal sSql As String, Optional ByVal bHeader As Boolean True, Optional ByVal lFirstRow As Long 1, Optional ByVal lLastRow As Long = 0) As Boolean
'*****************************************************************************
'* Auteur : PCPT >> Www.Vbfrance.com *
'* *
'* Fonction remplissage de colonnes (headers / nom des tables) et des *
'* champs avec "LIMIT" définissable dans ListView à partir *
'* d'une Connexion ADO active *
'* *
'* ----------------------- *
'* -Ajout Référence projet : Microsoft ActiveX Data Objects 2.5 Library *
'* -Ajout composant : Microsoft Windows Common controls 6.0 *
'* ----------------------- *
'* *
'* ------------ *
'* Utilisation : *
'* ------------ *
'* les 5 premiers : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 1, 5 *
' *
'* les 5 seconds : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 6, 10 *
' *
'* du 11è à la fin : *
'* AddColLvi oCnxAdo, ListView1, sSql, , 11, 0 *
' *
'* tous sans Header : *
'* ListView1.ColumnHeaders.Add , , "champs 1" *
'* ListView1.ColumnHeaders.Add , , "champs 2" *
'* AddColLvi oCnxAdo, ListView1, sSql, False *
' *
'*****************************************************************************
' init function
AddColLvi = False
' Recordset
On Error Resume Next
oRstAdo.Cancel
oRstAdo.Close
Set oRstAdo = Nothing
Err.Clear
' cnx inexistante?
If oCnxAdo Is Nothing Then
Exit Function
ElseIf Not (oCnxAdo.State = adStateOpen) Then
Exit Function
End If
' sSql vide?
sSql = Trim$(sSql)
If LenB(sSql) = 0 Then Exit Function
' logique rows
If lFirstRow < 0 Then
Exit Function
ElseIf lLastRow < 0 Then
Exit Function
ElseIf (lLastRow > 0) And (lLastRow < lFirstRow) Then
Exit Function
End If
' variables
Dim i As Long
Dim j As Long
Dim Itmx As ListItem
' init Listview
If bHeader Then oLv.ListItems.Clear: oLv.ColumnHeaders.Clear
oLv.Visible = False
' quitte si erreurs
On Error GoTo Lbl_Err
' Paramètres RecordSet et lancement de la requête
oRstAdo.CursorLocation = adUseClient
oRstAdo.Open sSql, oCnxAdo, adOpenDynamic, adLockPessimistic
' Si il n'y a pas de champs on ne fait rien
If oRstAdo.Fields.Count > 0 Then
' header
If bHeader Then
' on affiche forcément toutes les colonnes puisque c'est la requête qui prévoit le retour
For i = 0 To oRstAdo.Fields.Count - 1
oLv.ColumnHeaders.Add , , oRstAdo.Fields(i).Name
Next i
End If
' champs. attention!! si pas de header, il faut évidemment que la listview ait été préparée avant!
If oRstAdo.RecordCount > 0 Then
' 1er champ zéro = aucun champs
If lFirstRow > 0 Then ' dernier champ zéro tous, trop grand> on réduit au dernier If (lLastRow 0) Or (lLastRow > oRstAdo.RecordCount) Then lLastRow oRstAdo.RecordCount
' ajoute
oRstAdo.Move lFirstRow - 1
For i = lFirstRow - 1 To lLastRow - 1
Set Itmx = oLv.ListItems.Add(, , CStr(oRstAdo.Fields(0).Value))
For j = 1 To oRstAdo.Fields.Count - 1
Itmx.SubItems(j) = IIf(LenB(oRstAdo.Fields(j).Value) > 0, oRstAdo.Fields(j).Value, vbNullString)
Next j
' passe à l'enregistrement suivant
If Not oRstAdo.EOF Then oRstAdo.MoveNext
Next i
' Pas d'erreur
AddColLvi = True
Else
' pas de champs mais pas d'erreur pour autant
AddColLvi = True
End If
Else
' Pas d'erreur
AddColLvi = True
End If
End If
' gestion d'erreur s'il y en a eu
Lbl_Err:
If Not (Err.Number = 0) Then
AddColLvi = False
Err.Clear
End If
oLv.Visible = True
' libération objet
Set Itmx = Nothing
End Function
Public Sub ResizeLv(oFrm As Form, oLv As ListView)
'**************************************************************************/
' Sub qui ajuste mes colonnes à mes Listview's /
'**************************************************************************/
' By Jack >> Www.Vbfrance.com
' On va régler la largeur des colonnes en fonction du contenu
Dim r As Integer, t As Long, Largeur As Long, Max As Long
' init Listview
oLv.Visible = False
' 1ere colonne (n'est pas une SubItem)
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(1).Text)
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).Text)
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(1).Width = Max * 2.3
For r = 2 To oLv.ColumnHeaders.Count
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(r).Text)
' Ensuite, le test de ttes les données
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).SubItems(r - 1))
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(r).Width = Max * 2.3
Next r
' init Listview
oLv.Visible = True
End Sub
Public Sub ResizeCcLst(oFrm As Form, oLv As ListView)
'**************************************************************************/
' Sub qui ajuste mes colonnes à mes Listview's /
'**************************************************************************/
' By Jack >> Www.Vbfrance.com
' On va régler la largeur des colonnes en fonction du contenu
Dim r As Integer, t As Long, Largeur As Long, Max As Long
' init Listview
oLv.Visible = False
' 1ere colonne (n'est pas une SubItem)
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(1).Text)
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).Text)
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(1).Width = Max * 2.3
For r = 2 To oLv.ColumnHeaders.Count
' 1ere valeur : la largeur de l'étiquette
Max = oFrm.TextWidth(oLv.ColumnHeaders(r).Text)
' Ensuite, le test de ttes les données
For t = 1 To oLv.ListItems.Count
Largeur = oFrm.TextWidth(oLv.ListItems(t).SubItems(r - 1))
If Largeur > Max Then Max = Largeur
Next t
oLv.ColumnHeaders(r).Width = Max * 2.3
Next r
' init Listview
oLv.Visible = True
End Sub
Public Sub ChargeLV(oFrm As Form, oLv As ListView)
' Remplissage de Listview(Form2)
If AddColLvi(oCnxAdo, oLv, "Select * From Clients") Then
' Affiche dans (CcLst)
oLv.View = lvwReport
oLv.Font.Size = 10
oLv.Sorted = False
' Rsize des colonnes Listview
ResizeCcLst oFrm, oLv
End If
End Sub
Form1 :
Option Explicit
Private Sub CcBtnClient_Click()
' Remplissage de Listview(Form2)
ChargeLV Form2, Form2.CcLst
' Affiche From2
Form2.Show (vbModal)
End Sub
Private Sub Command1_Click()
' Quitte / ferme la base et décharge Form1
CloseDataBase
Unload Me
End Sub
Private Sub Form_Load()
' Demande la connection à la base
If Not OpenDataBase Then MsgBox "Erreur...connection impossible !", vbExclamation Or vbOKOnly, "Erreur de connection": Unload Me
' Remplissage de Listview(Form2)
ChargeLV Form2, Form2.CcLst
End Sub
Form2 :
Option Explicit
Private Sub CcBtnCancel_Click()
' Retour sur Form1 par défaut
' et décharge Form2
Unload Me
End Sub
Private Sub CcLst_ItemClick(ByVal ItemValide As ListItem)
' Variable de travail
Dim lIndex As Long
Dim lPos As Long
' Récupération de l'index
lIndex = ItemValide.Index
' Récupère l'id et la position dans la ListView
lPos = CLng(CcLst.ListItems(lIndex).Text)
' Affichage dans Form1
Form1.Text1(0).Text = CcLst.ListItems(lIndex).Text
Form1.Text1(1).Text = CcLst.ListItems(lIndex).SubItems(1)
Form1.Text1(2).Text = CcLst.ListItems(lIndex).SubItems(2)
Form1.Text1(3).Text = CcLst.ListItems(lIndex).SubItems(3)
Form1.CcTxtClient.Text = CcLst.ListItems(lIndex).Text
Unload Me
End Sub
Note : Par le click dans Listview, plus besoin à mon sens du bouton "OK"
A+
Exploreur
Linux a un noyau, Windows un pépin
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
29 avril 2008 à 19:06
29 avril 2008 à 19:06
Oups..pas besoin de :
Dim lPos As Long
' Récupère l'id et la position dans la ListView
lPos = CLng(CcLst.ListItems(lIndex).Text)
A+
Exploreur
Linux a un noyau, Windows un pépin
Dim lPos As Long
' Récupère l'id et la position dans la ListView
lPos = CLng(CcLst.ListItems(lIndex).Text)
A+
Exploreur
Linux a un noyau, Windows un pépin
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
74
30 avril 2008 à 06:24
30 avril 2008 à 06:24
"Note : Par le click dans Listview, plus besoin à mon sens du bouton "OK""
en fait, faut rester ouvert...
double-click d'un élémént va valider
selection puis Ok également
le double click d'un élémént reste une manipulation pour les users avertis ^^
en fait, faut rester ouvert...
double-click d'un élémént va valider
selection puis Ok également
le double click d'un élémént reste une manipulation pour les users avertis ^^
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
30 avril 2008 à 08:34
30 avril 2008 à 08:34
Oki....
A+
Exploreur
Linux a un noyau, Windows un pépin
A+
Exploreur
Linux a un noyau, Windows un pépin
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
30 avril 2008 à 09:15
30 avril 2008 à 09:15
Re,
Modife : Sélection de 'linfi via DblClick CcLst :
Form2 :
Option Explicit
Dim lCcLstIndex As Long ' Récupère élément sélectionné dans CcLst
Private Sub CcBtnCancel_Click()
' Retour sur Form1 par défaut
' et décharge Form2
Unload Me
End Sub
Private Sub CcBtnOk_Click()
' Affichage dans Form1
With Form1
.Text1(0).Text = CcLst.ListItems(lCcLstIndex).Text
.Text1(1).Text = CcLst.ListItems(lCcLstIndex).SubItems(1)
.Text1(2).Text = CcLst.ListItems(lCcLstIndex).SubItems(2)
.Text1(3).Text = CcLst.ListItems(lCcLstIndex).SubItems(3)
.CcTxtClient.Text = CcLst.ListItems(lCcLstIndex).Text
End With
' Décharge Form2 et retout Form1
Unload Me
End Sub
Private Sub CcLst_DblClick()
' Quel élément sélectionné ?
lCcLstIndex = CLng(Me.CcLst.SelectedItem.Text)
' Validation par click forcé !
CcBtnOk_Click
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
Modife : Sélection de 'linfi via DblClick CcLst :
Form2 :
Option Explicit
Dim lCcLstIndex As Long ' Récupère élément sélectionné dans CcLst
Private Sub CcBtnCancel_Click()
' Retour sur Form1 par défaut
' et décharge Form2
Unload Me
End Sub
Private Sub CcBtnOk_Click()
' Affichage dans Form1
With Form1
.Text1(0).Text = CcLst.ListItems(lCcLstIndex).Text
.Text1(1).Text = CcLst.ListItems(lCcLstIndex).SubItems(1)
.Text1(2).Text = CcLst.ListItems(lCcLstIndex).SubItems(2)
.Text1(3).Text = CcLst.ListItems(lCcLstIndex).SubItems(3)
.CcTxtClient.Text = CcLst.ListItems(lCcLstIndex).Text
End With
' Décharge Form2 et retout Form1
Unload Me
End Sub
Private Sub CcLst_DblClick()
' Quel élément sélectionné ?
lCcLstIndex = CLng(Me.CcLst.SelectedItem.Text)
' Validation par click forcé !
CcBtnOk_Click
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
30 avril 2008 à 11:19
30 avril 2008 à 11:19
Re,
Ben...si on utilise le DblClick...ma fois utilisons aussi le Click :
Private Sub CcLst_Click()
' Quel élément sélectionné ?
lCcLstIndex = CLng(Me.CcLst.SelectedItem.Text)
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
Ben...si on utilise le DblClick...ma fois utilisons aussi le Click :
Private Sub CcLst_Click()
' Quel élément sélectionné ?
lCcLstIndex = CLng(Me.CcLst.SelectedItem.Text)
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
74
30 avril 2008 à 11:24
30 avril 2008 à 11:24
effectivement, ca manquait ^^
mais c'est ok (remarques, il suffit dans le CcBtnOk de regarder le SelectedItem ^^
mais c'est ok (remarques, il suffit dans le CcBtnOk de regarder le SelectedItem ^^
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
30 avril 2008 à 11:59
30 avril 2008 à 11:59
Lol...tu as raison...d'ailleurs sans un test dans le CcBtnOk cela fait un gros caca-boudin...lol..
Private Sub CcBtnOk_Click()
' Variable de travail
Dim iBoucle As Integer
' Affichage dans Form1
' l'user a choisi un élément ???
If lCcLstIndex > 0 Then
With Form1
' Premier élément de CcLst sans index..normal !
.Text1(0).Text = CcLst.ListItems(lCcLstIndex).Text
' Le reste est indéxés
For iBoucle = 1 To 3
.Text1(iBoucle).Text = CcLst.ListItems(lCcLstIndex).SubItems(iBoucle)
Next iBoucle
' Donne le nom à CcTxtClient
.CcTxtClient.Text = CcLst.ListItems(lCcLstIndex).SubItems(1)
End With
End If
' Décharge Form2 et retout Form1
Unload Me
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
Private Sub CcBtnOk_Click()
' Variable de travail
Dim iBoucle As Integer
' Affichage dans Form1
' l'user a choisi un élément ???
If lCcLstIndex > 0 Then
With Form1
' Premier élément de CcLst sans index..normal !
.Text1(0).Text = CcLst.ListItems(lCcLstIndex).Text
' Le reste est indéxés
For iBoucle = 1 To 3
.Text1(iBoucle).Text = CcLst.ListItems(lCcLstIndex).SubItems(iBoucle)
Next iBoucle
' Donne le nom à CcTxtClient
.CcTxtClient.Text = CcLst.ListItems(lCcLstIndex).SubItems(1)
End With
End If
' Décharge Form2 et retout Form1
Unload Me
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
74
5 mai 2008 à 13:14
5 mai 2008 à 13:14
article publié ici:
http://blogs.codes-sources.com/renfield/archive/2008/05/05/vb6-bo-tes-de-dialogue-communication-inter-form.aspx
merci encore à tous
http://blogs.codes-sources.com/renfield/archive/2008/05/05/vb6-bo-tes-de-dialogue-communication-inter-form.aspx
merci encore à tous
