Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel modif de code (JB)

modif de code (JB)

3 réponses
Avatar
sylvain
bonjour a tous
ce code fourni par JB etait parfaitement adapte a ma demande
je souhaiterais pouvoir le modifier
pour l'instant l'affichage de la photo se fait par rapport a la donnee
fournie par la combox 3 "(qui recherche une espece)
est il possible que la photo affichee tienne compte de la donnee
inscrite dans la "combox 2 "(genre) en plus de la donnee cmbox3 "
espece"
la photo s'afficherait donc en tenant compte du genre et de l'espece
je n'y ai pas pense tout suite mais chez les poissons on peut avoir
des noms d'especes idem pour des genres differents
genre espece
ex:nimbochromis nourrissati
capidochromis nourrissati
je suis donc obliger de tenir compte des 2 combox
je renommerai donc mes photos avec le genre et l'espece
merci encore de votre aide
code
Private Sub UserForm_Initialize()
Me.ChoixFeuille.Clear
For Each s In Array("AMCENTRALE", "AMSUD", "LAC MALAWI", "LAC
VICTORIA", "LAC TANGANYICA", "MADAGASCAR", "GUYANE", "FLUVATILES
AFRICAINS")
Me.ChoixFeuille.AddItem s
Next s
End Sub
Private Sub ChoixFeuille_Change()
Sheets("RECHERCHE").[H2] = Me.ChoixFeuille
feuille = Me.ChoixFeuille
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range(Sheets(feuille).[C2], Sheets(feuille).
[C65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Me.cbxNiveau1.List = MonDico.items
End Sub
Private Sub cbxNiveau1_Change()
feuille = Me.ChoixFeuille
Set MonDico = CreateObject("Scripting.Dictionary")
Me.cbxNiveau2.Clear
For Each c In Range(Sheets(feuille).[D2], Sheets(feuille).
[D65000].End(xlUp))
If c.Offset(0, -1) = Me.cbxNiveau1 Then MonDico.Add c.Value,
c.Value
Next c
Me.cbxNiveau2.List = MonDico.items
End Sub
Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
rep = "c:\Documents and Settings\sylvain\mes documents\mes 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
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
JB
Bonsoir,

On suppose que les images sont nommées

PARACHROMIS_scalaire
HEROTILAPIA_scalaire
....

Les 2 lignes à modifier:

If Dir(rep & "" & Me.cbxNiveau1 & "_" & Me.cbxNiveau2 & ".jpg")
<> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau1 & "_" &
Me.cbxNiveau2 & ".jpg")


Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
'rep = "c:Documents and Settingssylvainmes documentsmespoissons
" "
With ActiveSheet.photo
If Dir(rep & "" & Me.cbxNiveau1 & "_" & Me.cbxNiveau2 &
".jpg") <> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau1 & "_" &
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

JB

On 19 juin, 18:00, sylvain wrote:
bonjour a tous
ce code fourni par JB etait parfaitement adapte a ma demande
je souhaiterais pouvoir le modifier
pour l'instant l'affichage de la photo se fait par rapport a la donnee
fournie par la combox 3 "(qui recherche une espece)
est il possible que la photo affichee tienne compte de la donnee
inscrite dans la "combox 2 "(genre) en plus de la donnee cmbox3 "
espece"
la photo s'afficherait donc en tenant compte du genre et de l'espece
je n'y ai pas pense tout suite mais chez les poissons on peut avoir
des noms d'especes idem pour des genres differents
genre espece
ex:nimbochromis nourrissati
capidochromis nourrissati
je suis donc obliger de tenir compte des 2 combox
je renommerai donc mes photos avec le genre et l'espece
merci encore de votre aide
code
Private Sub UserForm_Initialize()
Me.ChoixFeuille.Clear
For Each s In Array("AMCENTRALE", "AMSUD", "LAC MALAWI", "LAC
VICTORIA", "LAC TANGANYICA", "MADAGASCAR", "GUYANE", "FLUVATILES
AFRICAINS")
Me.ChoixFeuille.AddItem s
Next s
End Sub
Private Sub ChoixFeuille_Change()
Sheets("RECHERCHE").[H2] = Me.ChoixFeuille
feuille = Me.ChoixFeuille
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range(Sheets(feuille).[C2], Sheets(feuille).
[C65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Me.cbxNiveau1.List = MonDico.items
End Sub
Private Sub cbxNiveau1_Change()
feuille = Me.ChoixFeuille
Set MonDico = CreateObject("Scripting.Dictionary")
Me.cbxNiveau2.Clear
For Each c In Range(Sheets(feuille).[D2], Sheets(feuille).
[D65000].End(xlUp))
If c.Offset(0, -1) = Me.cbxNiveau1 Then MonDico.Add c.Value,
c.Value
Next c
Me.cbxNiveau2.List = MonDico.items
End Sub
Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
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


Avatar
sylvain
bonsoir JB
je viens de faire les changements
sur ces 2 lignes
If Dir(rep & "" & Me.cbxNiveau1 & "_" & Me.cbxNiveau2 & ".jpg")
<> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau1 & "_" &
Me.cbxNiveau2 & ".jpg")
ainsi que sur les noms de mes photos
mais pour l'instant les photos ne s'affichent plus
estce qu'il ne faut pas modifier qq chose par rapport a la cellule
"f2" sur la feuille recherche" car cette cellule ne prend en compte
que le nom de l'espece
ne doit elle pas prendre egalement le genre
merci pour votre aide precieuse
sr

On 19 juin, 20:34, JB wrote:
Bonsoir,

On suppose que les images sont nomm es

PARACHROMIS_scalaire
HEROTILAPIA_scalaire
....

Les 2 lignes modifier:

If Dir(rep & "" & Me.cbxNiveau1 & "_" & Me.cbxNiveau2 & ".jpg")
<> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau1 & "_" &
Me.cbxNiveau2 & ".jpg")

Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
'rep = "c:Documents and Settingssylvainmes documentsmespoissons
" "
With ActiveSheet.photo
If Dir(rep & "" & Me.cbxNiveau1 & "_" & Me.cbxNiveau2 &
".jpg") <> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau1 & "_" &
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

JB

On 19 juin, 18:00, sylvain wrote:



bonjour a tous
ce code fourni par JB etait parfaitement adapte a ma demande
je souhaiterais pouvoir le modifier
pour l'instant l'affichage de la photo se fait par rapport a la donnee
fournie par la combox 3 "(qui recherche une espece)
est il possible que la photo affichee tienne compte de la donnee
inscrite dans la "combox 2 "(genre) en plus de la donnee cmbox3 "
espece"
la photo s'afficherait donc en tenant compte du genre et de l'espece
je n'y ai pas pense tout suite mais chez les poissons on peut avoir
des noms d'especes idem pour des genres differents
genre espece
ex:nimbochromis nourrissati
capidochromis nourrissati
je suis donc obliger de tenir compte des 2 combox
je renommerai donc mes photos avec le genre et l'espece
merci encore de votre aide
code
Private Sub UserForm_Initialize()
Me.ChoixFeuille.Clear
For Each s In Array("AMCENTRALE", "AMSUD", "LAC MALAWI", "LAC
VICTORIA", "LAC TANGANYICA", "MADAGASCAR", "GUYANE", "FLUVATILES
AFRICAINS")
Me.ChoixFeuille.AddItem s
Next s
End Sub
Private Sub ChoixFeuille_Change()
Sheets("RECHERCHE").[H2] = Me.ChoixFeuille
feuille = Me.ChoixFeuille
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range(Sheets(feuille).[C2], Sheets(feuille).
[C65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Me.cbxNiveau1.List = MonDico.items
End Sub
Private Sub cbxNiveau1_Change()
feuille = Me.ChoixFeuille
Set MonDico = CreateObject("Scripting.Dictionary")
Me.cbxNiveau2.Clear
For Each c In Range(Sheets(feuille).[D2], Sheets(feuille).
[D65000].End(xlUp))
If c.Offset(0, -1) = Me.cbxNiveau1 Then MonDico.Add c.Value,
c.Value
Next c
Me.cbxNiveau2.List = MonDico.items
End Sub
Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
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- Masquer le texte des messages pr c dents -


- Afficher le texte des messages pr c dents -



Avatar
sylvain
On 19 juin, 21:51, sylvain wrote:
excusez moi
en fait cela fonctionne correctement
j'avais oublie de mettre le tiret entre le genre et l'espece quand
j'ai renomme les photos
donc c'est super
merci beaucoup



bonsoir JB
je viens de faire les changements
sur ces 2 lignes
If Dir(rep & "" & Me.cbxNiveau1 & "_" & Me.cbxNiveau2 & ".jpg")
<> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau1 & "_" &
Me.cbxNiveau2 & ".jpg")
ainsi que sur les noms de mes photos
mais pour l'instant les photos ne s'affichent plus
estce qu'il ne faut pas modifier qq chose par rapport a la cellule
"f2" sur la feuille recherche" car cette cellule ne prend en compte
que le nom de l'espece
ne doit elle pas prendre egalement le genre
merci pour votre aide precieuse
sr

On 19 juin, 20:34, JB wrote:



Bonsoir,

On suppose que les images sont nomm es

PARACHROMIS_scalaire
HEROTILAPIA_scalaire
....

Les 2 lignes modifier:

If Dir(rep & "" & Me.cbxNiveau1 & "_" & Me.cbxNiveau2 & ".jpg")
<> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau1 & "_" &
Me.cbxNiveau2 & ".jpg")

Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
'rep = "c:Documents and Settingssylvainmes documentsmespoissons
" "
With ActiveSheet.photo
If Dir(rep & "" & Me.cbxNiveau1 & "_" & Me.cbxNiveau2 &
".jpg") <> "" Then
.Picture = LoadPicture(rep & "" & Me.cbxNiveau1 & "_" &
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

JB

On 19 juin, 18:00, sylvain wrote:

bonjour a tous
ce code fourni par JB etait parfaitement adapte a ma demande
je souhaiterais pouvoir le modifier
pour l'instant l'affichage de la photo se fait par rapport a la donnee
fournie par la combox 3 "(qui recherche une espece)
est il possible que la photo affichee tienne compte de la donnee
inscrite dans la "combox 2 "(genre) en plus de la donnee cmbox3 "
espece"
la photo s'afficherait donc en tenant compte du genre et de l'espece
je n'y ai pas pense tout suite mais chez les poissons on peut avoir
des noms d'especes idem pour des genres differents
genre espece
ex:nimbochromis nourrissati
capidochromis nourrissati
je suis donc obliger de tenir compte des 2 combox
je renommerai donc mes photos avec le genre et l'espece
merci encore de votre aide
code
Private Sub UserForm_Initialize()
Me.ChoixFeuille.Clear
For Each s In Array("AMCENTRALE", "AMSUD", "LAC MALAWI", "LAC
VICTORIA", "LAC TANGANYICA", "MADAGASCAR", "GUYANE", "FLUVATILES
AFRICAINS")
Me.ChoixFeuille.AddItem s
Next s
End Sub
Private Sub ChoixFeuille_Change()
Sheets("RECHERCHE").[H2] = Me.ChoixFeuille
feuille = Me.ChoixFeuille
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In Range(Sheets(feuille).[C2], Sheets(feuille).
[C65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Me.cbxNiveau1.List = MonDico.items
End Sub
Private Sub cbxNiveau1_Change()
feuille = Me.ChoixFeuille
Set MonDico = CreateObject("Scripting.Dictionary")
Me.cbxNiveau2.Clear
For Each c In Range(Sheets(feuille).[D2], Sheets(feuille).
[D65000].End(xlUp))
If c.Offset(0, -1) = Me.cbxNiveau1 Then MonDico.Add c.Value,
c.Value
Next c
Me.cbxNiveau2.List = MonDico.items
End Sub
Private Sub cbxNiveau2_Change()
Sheets("RECHERCHE").[f2] = Me.cbxNiveau2
rep = ActiveWorkbook.Path
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- Masquer le texte des messages pr c dents -


- Afficher le texte des messages pr c dents -- Masquer le texte des messages pr c dents -


- Afficher le texte des messages pr c dents -