base de donnee

Le
sylvain
bonjour a tous
Le code suivant fourni par JB me permet de faire exactement ce que je
lui ai demande ;rechercher des donnees dans 1 tableau pour alimenter
2 combox dans 1 userform ;ces donnees se trouvant dans 1 feuille
je souhaiter ajouter une 3e combox dans cet userform qui me
permettrai toujours de remplir les 2 premieres combox mais cette
fois suivant le nom de la feuille afficher dans 3 combox
qq peut il m'aider n'ayant pas les connaissances suffisantes pour cela
merci de votre aide
le code
Private Sub UserForm_Initialize()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In [genre]
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.cbxNiveau1.List = temp
End Sub
Private Sub cbxNiveau1_Change()
Set MonDico = CreateObject("Scripting.Dictionary")
Me.cbxNiveau2.Clear
For Each c In [Espece]
If c.Offset(0, -1) = Me.cbxNiveau1 Then MonDico.Add c.Value,
c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.cbxNiveau2.List = temp
End Sub
Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
'inscrire le dossier ou sont stockees les photos,il faut qu'il soit
dans 1 dosier differents de la feuill excel
rep = "c:Documents and Settingssylvainmes documentsmes
poissons"
With ActiveSheet.photo
If Dir(rep & "" & Me.cbxNiveau2 & ".jpg") <> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau2 & ".jpg")
.Left = Range("f3").Left
.Top = Range("f3").Top
'.PictureSizeMode = fmPictureSizeModeZoom
Else
On Error Resume Next
.Picture = LoadPicture(rep & "transparent.gif")
End If
End With
End Sub
Private Sub btnQuitter_Click()
Unload Me
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
ref = a((gauc + droi) 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #4917451
Bonsoir,

http://cjoint.com/?gmuX2NvEao

JB

On 12 juin, 18:02, sylvain
bonjour a tous
Le code suivant fourni par JB me permet de faire exactement ce que je
lui ai demande ;rechercher des donnees dans 1 tableau pour alimenter
2 combox dans 1 userform ;ces donnees se trouvant dans 1 feuille
je souhaiter ajouter une 3e combox dans cet userform qui me
permettrai toujours de remplir les 2 premieres combox mais cette
fois suivant le nom de la feuille afficher dans 3 combox
qq peut il m'aider n'ayant pas les connaissances suffisantes pour cela
merci de votre aide
le code
Private Sub UserForm_Initialize()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In [genre]
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.cbxNiveau1.List = temp
End Sub
Private Sub cbxNiveau1_Change()
Set MonDico = CreateObject("Scripting.Dictionary")
Me.cbxNiveau2.Clear
For Each c In [Espece]
If c.Offset(0, -1) = Me.cbxNiveau1 Then MonDico.Add c.Value,
c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.cbxNiveau2.List = temp
End Sub
Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
'inscrire le dossier ou sont stockees les photos,il faut qu'il soit
dans 1 dosier differents de la feuill excel
rep = "c:Documents and Settingssylvainmes documentsmes
poissons"
With ActiveSheet.photo
If Dir(rep & "" & Me.cbxNiveau2 & ".jpg") <> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau2 & ".jpg")
.Left = Range("f3").Left
.Top = Range("f3").Top
'.PictureSizeMode = fmPictureSizeModeZoom
Else
On Error Resume Next
.Picture = LoadPicture(rep & "transparent.gif")
End If
End With
End Sub
Private Sub btnQuitter_Click()
Unload Me
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
ref = a((gauc + droi) 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub


sylvain
Le #4917271
bonsoir
un seul mot "SUPER"
vraiment un grand merci pour aide


On 12 juin, 20:50, JB
Bonsoir,

http://cjoint.com/?gmuX2NvEao

JB

On 12 juin, 18:02, sylvain


bonjour a tous
Le code suivant fourni par JB me permet de faire exactement ce que je
lui ai demande ;rechercher des donnees dans 1 tableau pour alimenter
2 combox dans 1 userform ;ces donnees se trouvant dans 1 feuille
je souhaiter ajouter une 3e combox dans cet userform qui me
permettrai toujours de remplir les 2 premieres combox mais cette
fois suivant le nom de la feuille afficher dans 3 combox
qq peut il m'aider n'ayant pas les connaissances suffisantes pour cela
merci de votre aide
le code
Private Sub UserForm_Initialize()
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In [genre]
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.cbxNiveau1.List = temp
End Sub
Private Sub cbxNiveau1_Change()
Set MonDico = CreateObject("Scripting.Dictionary")
Me.cbxNiveau2.Clear
For Each c In [Espece]
If c.Offset(0, -1) = Me.cbxNiveau1 Then MonDico.Add c.Value,
c.Value
Next c
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.cbxNiveau2.List = temp
End Sub
Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
'inscrire le dossier ou sont stockees les photos,il faut qu'il soit
dans 1 dosier differents de la feuill excel
rep = "c:Documents and Settingssylvainmes documentsmes
poissons"
With ActiveSheet.photo
If Dir(rep & "" & Me.cbxNiveau2 & ".jpg") <> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau2 & ".jpg")
.Left = Range("f3").Left
.Top = Range("f3").Top
'.PictureSizeMode = fmPictureSizeModeZoom
Else
On Error Resume Next
.Picture = LoadPicture(rep & "transparent.gif")
End If
End With
End Sub
Private Sub btnQuitter_Click()
Unload Me
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
ref = a((gauc + droi) 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub- Masquer le texte des messages pr c dents -


- Afficher le texte des messages pr c dents -



Publicité
Poster une réponse
Anonyme