Maj à jour d’un Userform ,module de classe

Le
Jean-Paul V
Bonjour à tous
Je me suis inspiré du fichier Annuaire2Photo2
(http://boisgontierjacques.free.fr/fichiers/Formulaire/Annuaire2Photo2.xls)
de JB trouvé dans :
http://boisgontierjacques.free.fr/

Pourquoi la macro MajFiche ne se fait pas dans ma macro lorsque Me.Lettre
est B par exemple alors que pour Tous ça marche ???

Voir les deux fichiers sur :
http://cjoint.com/?gtsg7zkRhG
http://cjoint.com/?gtsjmrQb2g

la macro JB est :

Private Sub B_suiv_Click()
If Me.Lettre = "Tous" Then
If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
If Me.nom <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
Else
If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
If Me.nom <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
End If
End Sub

Sub majFiche()
Me.nom = Sheets("BD").Cells(ligne, 1)
Me.Service = Sheets("BD").Cells(ligne, 2)
.
répertoire = ThisWorkbook.Path
If Dir(Me.CheminPhoto) <> "" Then
On Error Resume Next
Me.Image1.Picture = LoadPicture(Me.CheminPhoto)
Else
Me.Image1.Picture = LoadPicture
End If
End Sub
Mes 2 macros sont :

Private Sub B_suiv_Click()
If Me.Lettre = "Tous" Then
If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
If Me.Compositeur <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
Else
If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
If Me.Compositeur <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
End If
End Sub

Sub majFiche()
Me.Compositeur = Sheets("BD").Cells(ligne, 1)
Me.Prénom = Sheets("BD").Cells(ligne, 2)
….
Me.Photo = Sheets("BD").Cells(ligne, 11)
répertoire = ThisWorkbook.Path
If Dir(Me.Photo) <> "" Then
On Error Resume Next
ChDrive Left(ActiveWorkbook.Path, 1)
ChDir ActiveWorkbook.Path
Formulaire.Image1.PictureSizeMode = fmPictureSizeModeZoom
Me.Image1.Picture = LoadPicture(Me.Photo)
Else
Me.Image1.Picture = LoadPicture
End If
End Sub

A + j’espère

--
Jean-Paul V
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
MichDenis
Le #19600981
Bonjour Jean-Paul,

Je n'ai pas le temps de fouiller le site dont tu fais référence,
mais en jetant un coup d'oeil rapide à ton classeur, Es-tu sûr
d'avoir pris le temps de copier tout le code de l'exemple ?

Sinon l'auteur référencé pourra t'aider plus tard !




"Jean-Paul V" discussion :
Bonjour à tous
Je me suis inspiré du fichier Annuaire2Photo2
(http://boisgontierjacques.free.fr/fichiers/Formulaire/Annuaire2Photo2.xls)
de JB trouvé dans :
http://boisgontierjacques.free.fr/

Pourquoi la macro MajFiche ne se fait pas dans ma macro lorsque Me.Lettre
est B par exemple alors que pour Tous ça marche ???

Voir les deux fichiers sur :
http://cjoint.com/?gtsg7zkRhG
http://cjoint.com/?gtsjmrQb2g

la macro JB est :

Private Sub B_suiv_Click()
If Me.Lettre = "Tous" Then
If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
If Me.nom <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
Else
If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
If Me.nom <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
End If
End Sub

Sub majFiche()
Me.nom = Sheets("BD").Cells(ligne, 1)
Me.Service = Sheets("BD").Cells(ligne, 2)
....
répertoire = ThisWorkbook.Path
If Dir(Me.CheminPhoto) <> "" Then
On Error Resume Next
Me.Image1.Picture = LoadPicture(Me.CheminPhoto)
Else
Me.Image1.Picture = LoadPicture
End If
End Sub
Mes 2 macros sont :

Private Sub B_suiv_Click()
If Me.Lettre = "Tous" Then
If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
If Me.Compositeur <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
Else
If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
If Me.Compositeur <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
End If
End Sub

Sub majFiche()
Me.Compositeur = Sheets("BD").Cells(ligne, 1)
Me.Prénom = Sheets("BD").Cells(ligne, 2)
….
Me.Photo = Sheets("BD").Cells(ligne, 11)
répertoire = ThisWorkbook.Path
If Dir(Me.Photo) <> "" Then
On Error Resume Next
ChDrive Left(ActiveWorkbook.Path, 1)
ChDir ActiveWorkbook.Path
Formulaire.Image1.PictureSizeMode = fmPictureSizeModeZoom
Me.Image1.Picture = LoadPicture(Me.Photo)
Else
Me.Image1.Picture = LoadPicture
End If
End Sub

A + j’espère

--
Jean-Paul V
Jean-Paul V
Le #19601301
Bonjour MichDenis
Pour être sur de ne rien oublier je suis parti du fichier de JB que j'ai
progressivement modifié en fonction de mes besoins en testant après chaque
chgt que ça marchait.

Le seul point que je ne comprends pas totalement c'est dans le module de
classe il y a un truc que je n'ai pas trouvé défini dans le Userform c'est
GrLettres ( il semble que l'on parle de l'ensemble des 27 boutons dont les
Caption respectif sont A ; B ; C ....Tous or il ne sont pas dans un frame ):

Public WithEvents GrLettres As MSForms.CommandButton
Private Sub GrLettres_Click()
Formulaire.Lettre = GrLettres.Caption
Formulaire.choixnom.Clear
If GrLettres.Caption = "Tous" Then
'Ancien
' For Each c In Range(Sheets("BD").[A2], Sheets("BD").[A65000].End(xlUp))
' F_Lettre2.choixnom.AddItem c
' Next c
'Nouveau évite les doublons
Set f = Sheets("BD")
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Formulaire.choixnom.List = MonDico.items

Else
'Ancien
' For Each c In Range(Sheets("BD").[A2], Sheets("BD").[B65000].End(xlUp))
' If Left(c.Value, 1) = GrLettres.Caption Then
F_Lettre2.choixnom.AddItem c
' Next c
'Nouveau
Set f = Sheets("BD")
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Left(c.Value, 1) = GrLettres.Caption And Not
MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Formulaire.choixnom.List = MonDico.items

End If
If Formulaire.choixnom.ListCount > 0 Then
Formulaire.choixnom.ListIndex = 0
End If
End Sub


--
Jean-Paul V


"MichDenis" wrote:

Bonjour Jean-Paul,

Je n'ai pas le temps de fouiller le site dont tu fais référence,
mais en jetant un coup d'oeil rapide à ton classeur, Es-tu sûr
d'avoir pris le temps de copier tout le code de l'exemple ?

Sinon l'auteur référencé pourra t'aider plus tard !




"Jean-Paul V" discussion :
Bonjour à tous
Je me suis inspiré du fichier Annuaire2Photo2
(http://boisgontierjacques.free.fr/fichiers/Formulaire/Annuaire2Photo2.xls)
de JB trouvé dans :
http://boisgontierjacques.free.fr/

Pourquoi la macro MajFiche ne se fait pas dans ma macro lorsque Me.Lettre
est B par exemple alors que pour Tous ça marche ???

Voir les deux fichiers sur :
http://cjoint.com/?gtsg7zkRhG
http://cjoint.com/?gtsjmrQb2g

la macro JB est :

Private Sub B_suiv_Click()
If Me.Lettre = "Tous" Then
If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
If Me.nom <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
Else
If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
If Me.nom <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
End If
End Sub

Sub majFiche()
Me.nom = Sheets("BD").Cells(ligne, 1)
Me.Service = Sheets("BD").Cells(ligne, 2)
....
répertoire = ThisWorkbook.Path
If Dir(Me.CheminPhoto) <> "" Then
On Error Resume Next
Me.Image1.Picture = LoadPicture(Me.CheminPhoto)
Else
Me.Image1.Picture = LoadPicture
End If
End Sub
Mes 2 macros sont :

Private Sub B_suiv_Click()
If Me.Lettre = "Tous" Then
If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
If Me.Compositeur <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
Else
If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
If Me.Compositeur <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
End If
End Sub

Sub majFiche()
Me.Compositeur = Sheets("BD").Cells(ligne, 1)
Me.Prénom = Sheets("BD").Cells(ligne, 2)
….
Me.Photo = Sheets("BD").Cells(ligne, 11)
répertoire = ThisWorkbook.Path
If Dir(Me.Photo) <> "" Then
On Error Resume Next
ChDrive Left(ActiveWorkbook.Path, 1)
ChDir ActiveWorkbook.Path
Formulaire.Image1.PictureSizeMode = fmPictureSizeModeZoom
Me.Image1.Picture = LoadPicture(Me.Photo)
Else
Me.Image1.Picture = LoadPicture
End If
End Sub

A + j’espère

--
Jean-Paul V




MichDenis
Le #19601281
J'ai fait quelques tests, et lorsque l'on clique sur le bouton B, la liste n'affiche que
les noms débutant par B. Tout semble fonctionner normalement. Tantôt, je n'avais pas vu
que l'instance de la classe objet était lancé à l'ouverture du formulaire.



"Jean-Paul V" discussion :
Bonjour MichDenis
Pour être sur de ne rien oublier je suis parti du fichier de JB que j'ai
progressivement modifié en fonction de mes besoins en testant après chaque
chgt que ça marchait.

Le seul point que je ne comprends pas totalement c'est dans le module de
classe il y a un truc que je n'ai pas trouvé défini dans le Userform c'est
GrLettres ( il semble que l'on parle de l'ensemble des 27 boutons dont les
Caption respectif sont A ; B ; C ....Tous or il ne sont pas dans un frame ):

Public WithEvents GrLettres As MSForms.CommandButton
Private Sub GrLettres_Click()
Formulaire.Lettre = GrLettres.Caption
Formulaire.choixnom.Clear
If GrLettres.Caption = "Tous" Then
'Ancien
' For Each c In Range(Sheets("BD").[A2], Sheets("BD").[A65000].End(xlUp))
' F_Lettre2.choixnom.AddItem c
' Next c
'Nouveau évite les doublons
Set f = Sheets("BD")
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Formulaire.choixnom.List = MonDico.items

Else
'Ancien
' For Each c In Range(Sheets("BD").[A2], Sheets("BD").[B65000].End(xlUp))
' If Left(c.Value, 1) = GrLettres.Caption Then
F_Lettre2.choixnom.AddItem c
' Next c
'Nouveau
Set f = Sheets("BD")
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Left(c.Value, 1) = GrLettres.Caption And Not
MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Formulaire.choixnom.List = MonDico.items

End If
If Formulaire.choixnom.ListCount > 0 Then
Formulaire.choixnom.ListIndex = 0
End If
End Sub


--
Jean-Paul V


"MichDenis" wrote:

Bonjour Jean-Paul,

Je n'ai pas le temps de fouiller le site dont tu fais référence,
mais en jetant un coup d'oeil rapide à ton classeur, Es-tu sûr
d'avoir pris le temps de copier tout le code de l'exemple ?

Sinon l'auteur référencé pourra t'aider plus tard !




"Jean-Paul V" discussion :
Bonjour à tous
Je me suis inspiré du fichier Annuaire2Photo2
(http://boisgontierjacques.free.fr/fichiers/Formulaire/Annuaire2Photo2.xls)
de JB trouvé dans :
http://boisgontierjacques.free.fr/

Pourquoi la macro MajFiche ne se fait pas dans ma macro lorsque Me.Lettre
est B par exemple alors que pour Tous ça marche ???

Voir les deux fichiers sur :
http://cjoint.com/?gtsg7zkRhG
http://cjoint.com/?gtsjmrQb2g

la macro JB est :

Private Sub B_suiv_Click()
If Me.Lettre = "Tous" Then
If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
If Me.nom <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
Else
If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
If Me.nom <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
End If
End Sub

Sub majFiche()
Me.nom = Sheets("BD").Cells(ligne, 1)
Me.Service = Sheets("BD").Cells(ligne, 2)
....
répertoire = ThisWorkbook.Path
If Dir(Me.CheminPhoto) <> "" Then
On Error Resume Next
Me.Image1.Picture = LoadPicture(Me.CheminPhoto)
Else
Me.Image1.Picture = LoadPicture
End If
End Sub
Mes 2 macros sont :

Private Sub B_suiv_Click()
If Me.Lettre = "Tous" Then
If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
If Me.Compositeur <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
Else
If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
If Me.Compositeur <> "" Then b_validation_Click
ligne = ligne + 1
majFiche
End If
End If
End Sub

Sub majFiche()
Me.Compositeur = Sheets("BD").Cells(ligne, 1)
Me.Prénom = Sheets("BD").Cells(ligne, 2)
….
Me.Photo = Sheets("BD").Cells(ligne, 11)
répertoire = ThisWorkbook.Path
If Dir(Me.Photo) <> "" Then
On Error Resume Next
ChDrive Left(ActiveWorkbook.Path, 1)
ChDir ActiveWorkbook.Path
Formulaire.Image1.PictureSizeMode = fmPictureSizeModeZoom
Me.Image1.Picture = LoadPicture(Me.Photo)
Else
Me.Image1.Picture = LoadPicture
End If
End Sub

A + j’espère

--
Jean-Paul V




Jean-Paul V
Le #19601711
Effectivement la liste est correcte mais on ne peut comme dans le fichier de
JB en cliquant sur > faire défiler les renseignements dans le Userform de
chaque Nom commençant par B alors que cela marche si à l'ouverture on les
garde Tous.
Et bizarrement lorsque plus tard j'aurais plusieurs BACH les faire tous
défiler cela ne marche plus ... ???

--
Jean-Paul V


"MichDenis" wrote:

J'ai fait quelques tests, et lorsque l'on clique sur le bouton B, la liste n'affiche que
les noms débutant par B. Tout semble fonctionner normalement. Tantôt, je n'avais pas vu
que l'instance de la classe objet était lancé à l'ouverture du formulaire.



"Jean-Paul V" discussion :
Bonjour MichDenis
Pour être sur de ne rien oublier je suis parti du fichier de JB que j'ai
progressivement modifié en fonction de mes besoins en testant après chaque
chgt que ça marchait.

Le seul point que je ne comprends pas totalement c'est dans le module de
classe il y a un truc que je n'ai pas trouvé défini dans le Userform c'est
GrLettres ( il semble que l'on parle de l'ensemble des 27 boutons dont les
Caption respectif sont A ; B ; C ....Tous or il ne sont pas dans un frame ):

Public WithEvents GrLettres As MSForms.CommandButton
Private Sub GrLettres_Click()
Formulaire.Lettre = GrLettres.Caption
Formulaire.choixnom.Clear
If GrLettres.Caption = "Tous" Then
'Ancien
' For Each c In Range(Sheets("BD").[A2], Sheets("BD").[A65000].End(xlUp))
' F_Lettre2.choixnom.AddItem c
' Next c
'Nouveau évite les doublons
Set f = Sheets("BD")
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Formulaire.choixnom.List = MonDico.items

Else
'Ancien
' For Each c In Range(Sheets("BD").[A2], Sheets("BD").[B65000].End(xlUp))
' If Left(c.Value, 1) = GrLettres.Caption Then
F_Lettre2.choixnom.AddItem c
' Next c
'Nouveau
Set f = Sheets("BD")
Set MonDico = CreateObject("Scripting.Dictionary")
For Each c In f.Range("A2", f.[A65000].End(xlUp))
If Left(c.Value, 1) = GrLettres.Caption And Not
MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
Next c
Formulaire.choixnom.List = MonDico.items

End If
If Formulaire.choixnom.ListCount > 0 Then
Formulaire.choixnom.ListIndex = 0
End If
End Sub


--
Jean-Paul V


"MichDenis" wrote:

> Bonjour Jean-Paul,
>
> Je n'ai pas le temps de fouiller le site dont tu fais référence,
> mais en jetant un coup d'oeil rapide à ton classeur, Es-tu sûr
> d'avoir pris le temps de copier tout le code de l'exemple ?
>
> Sinon l'auteur référencé pourra t'aider plus tard !
>
>
>
>
> "Jean-Paul V" > discussion :
> Bonjour à tous
> Je me suis inspiré du fichier Annuaire2Photo2
> (http://boisgontierjacques.free.fr/fichiers/Formulaire/Annuaire2Photo2.xls)
> de JB trouvé dans :
> http://boisgontierjacques.free.fr/
>
> Pourquoi la macro MajFiche ne se fait pas dans ma macro lorsque Me.Lettre
> est B par exemple alors que pour Tous ça marche ???
>
> Voir les deux fichiers sur :
> http://cjoint.com/?gtsg7zkRhG
> http://cjoint.com/?gtsjmrQb2g
>
> la macro JB est :
>
> Private Sub B_suiv_Click()
> If Me.Lettre = "Tous" Then
> If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
> If Me.nom <> "" Then b_validation_Click
> ligne = ligne + 1
> majFiche
> End If
> Else
> If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
> If Me.nom <> "" Then b_validation_Click
> ligne = ligne + 1
> majFiche
> End If
> End If
> End Sub
>
> Sub majFiche()
> Me.nom = Sheets("BD").Cells(ligne, 1)
> Me.Service = Sheets("BD").Cells(ligne, 2)
> ....
> répertoire = ThisWorkbook.Path
> If Dir(Me.CheminPhoto) <> "" Then
> On Error Resume Next
> Me.Image1.Picture = LoadPicture(Me.CheminPhoto)
> Else
> Me.Image1.Picture = LoadPicture
> End If
> End Sub
> Mes 2 macros sont :
>
> Private Sub B_suiv_Click()
> If Me.Lettre = "Tous" Then
> If ligne < Sheets("BD").[A65000].End(xlUp).Row Then
> If Me.Compositeur <> "" Then b_validation_Click
> ligne = ligne + 1
> majFiche
> End If
> Else
> If Left(Sheets("bd").Cells(ligne + 1, 1), 1) = Me.Lettre Then
> If Me.Compositeur <> "" Then b_validation_Click
> ligne = ligne + 1
> majFiche
> End If
> End If
> End Sub
>
> Sub majFiche()
> Me.Compositeur = Sheets("BD").Cells(ligne, 1)
> Me.Prénom = Sheets("BD").Cells(ligne, 2)
> ….
> Me.Photo = Sheets("BD").Cells(ligne, 11)
> répertoire = ThisWorkbook.Path
> If Dir(Me.Photo) <> "" Then
> On Error Resume Next
> ChDrive Left(ActiveWorkbook.Path, 1)
> ChDir ActiveWorkbook.Path
> Formulaire.Image1.PictureSizeMode = fmPictureSizeModeZoom
> Me.Image1.Picture = LoadPicture(Me.Photo)
> Else
> Me.Image1.Picture = LoadPicture
> End If
> End Sub
>
> A + j’espère
>
> --
> Jean-Paul V
>
>



Publicité
Poster une réponse
Anonyme