Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Maj à jour d’un Userform ,module de classe

Maj à jour d’un Userform ,module de classe

4 réponses
Avatar
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
Signaler un problème avec ce contenu

4 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
MichDenis
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" a écrit dans le message de groupe de
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
Avatar
Jean-Paul V
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" a écrit dans le message de groupe de
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




Avatar
MichDenis
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" a écrit dans le message de groupe de
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" a écrit dans le message de groupe de
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




Avatar
Jean-Paul V
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" a écrit dans le message de groupe de
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" a écrit dans le message de groupe de
> 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
>
>