Classeur avec plusieurs Userform

Version imprimable

10/08/2021, 18h53
Menalm11

1 pièce(s) jointe(s)

Classeur avec plusieurs Userform

Bonjour Forum,

J'ai un petit souci, j'ai un classeur avec plusieurs Userform identiques (userform/feuille), qui contiennt une ListBox et un combobox

J'ai testé mon premier Userform, qui marche, cependant pour les autres, la ListBox ne s'actualise pas avec les données de la feuille correspondante (alors que le Combobox s'actualise !)

Qqn peut m'aider SVP, c'est urgent :(

Vous trouvez en PJ, un exemple simplifié de mon fichier.

Merci d'avance.
10/08/2021, 19h53
Pierre Fauconnier

Salut.

ton fichier est tellement simplifié qu'on n'y comprend pas grand-chose. Je n'ai pas vu de code qui chargeait les données.

Tu tagues 365, donc tu pourrais (devrais?) utiliser les tableaux structurés, ainsi que les fonctions FILTRE, UNIQUE, etc pour remplir tes listbox et combobo.

Peut-être pourrais-tu expliquer en français (sans jargon Excel ou VBA) ce que tu souhaites réaliser?

PS: Les mots comme "urgent" sont rarement appréciés sur nos forums ;)
10/08/2021, 20h10
Menalm11

Merci pour ta réponse.

Je m'excuse, mais mon niveau en VBA/Excel, est très limité.

Mon objectif final est de remplir un fichier Word à partir d'un fichier Excel qui contient des information des client (Un fichier Word/client).

Comme, j'ai plusieurs catégories des clients (dans le fichier test, j'ai mis deux catégories: P9A et Crous), j'ai crée deux feuilles qui correspondent ayx deux catégories ainsi que deux formulaires (UserForm). A noter que les deux Userform (ainsi que les données des feuilles sont 100% indépendants).

Mon utilisateur devrait en cliquant sur une bouton se faire afficher le formulaire, déjà chargé avec les données de la feuille dans une ListBox et un Combox trié et filtré, et s' il sélectionne une valeur dans le Combox, on a uniquement la ligne correspndante dans la Listbox.

Mes macro fonctionnent parfaitement dans le cas d'un seul Userform, mais pour le deuxieme je n'ai pas reçu à faire les modifs nécessaires pour actualiser les données affichées dans la ListBox ( j'ai les données du premier UserForm !).

A noter que la plus part des codes, je l'ai récupérés en ligne donc je le maitrise pas vraiment ;)

Merci une autre fois, et j'espère que j'été claire dans mes explications :)
10/08/2021, 20h27
Pierre Fauconnier

Si tes deux userforms "font exactement la même chose", alors autant n'en utiliser qu'un seul.

Si le combobox ne sert qu'à filtrer les données du listbox, je ne vois pas bien l'intérêt. Autant sélectionner la ligne directement dans la listbox, non?

De plus, dans ton code, tu parles de "pack" mais je ne vois pas à quoi ça correspond...
10/08/2021, 20h33
Menalm11

J'utilise deux UserForm pour n' pas mélangé les catégories des clients ( après c'est possible d'ajouter une colonne pour faire ça).

L'idée du Combox, que les noms des clients sont classées par ordre croissant et sans doublon ( et pour cela qu'on utilise le module "fontions_range" de mon code).

Le Pack, c'est seulement, une nomenclature, ne signifie pas en elle même.

1 pièce(s) jointe(s)

J'ai transformé tes plages en tableaux structurés (voir mon tuto à ce sujet) et j'ai nommé les tableaux t_P9A et t_Crous. Travailler avec des tableaux structurés va te simplifier la vie tant en Excel qu'en VBA;
J'ai utilisé un seul userform pour gérer les deux tableaux puisque la finalité est la même;
J'ai supprimé la procédure Initialize du userform, préférant gérer l'initialisation dans des procédures d'amorce séparées;
J'ai ajouté une propriété publique SourceName au userform USF pour savoir quel tableau a été chargé;
Le filtrage selon le combobox s'effectue en utilisant la fonction FILTRE de XL365. Ca évite les dicos que l'on manipule souvent sans trop comprendre ce que l'on fait.

Du coup, les procédures d'amorce sont les suivantes:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub P9Aafficher() With Usf .SourceName = "t_P9A" .Lbx_grille.List = Range("t_p9a").Value .Cbx_pack.List = Range("t_p9a[site]").Value .Cbx_pack.ColumnCount = Range("t_p9a").Columns.Count .Show End With End Sub Sub Crousafficher() With Usf .SourceName = "t_Crous" .Lbx_grille.List = Range("t_crous").Value .Cbx_pack.List = Range("t_crous[Site]").Value .Cbx_pack.ColumnCount = Range("t_crous").Columns.Count .Show End With End Sub
L'événement Change du combo utilise alors FILTRE pour limiter la listbox aux données choisies. FILTRE en VBA se comporte bizarrement en ce sens que lorsque la fonction ne renvoie qu'une ligne du tableau, elle est transposée en VBA... C'est à mon avis une stupidité, mais on n'y peut rien. Du coup, on teste combien de lignes seront récupérées avec un NB.SI.ENS en VBA
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Cbx_pack_Change() Dim Data Dim CountOf As Long CountOf = Evaluate("countifs(" & SourceName & "[site],""" & Cbx_pack.Value & """)") If CountOf > 0 Then Data = Evaluate("filter(" & SourceName & "," & SourceName & "[site]=""" & Cbx_pack.Value & """)") If CountOf = 1 Then Lbx_grille.Column = Data Else Lbx_grille.List = Data End If Else Lbx_grille.Clear End If End Sub
Ca ne correspondra peut-être pas pile poil à ton souhait mais tu as une base qui te fixe le cadre de travail et qui te permet d'utiliser au mieux Excel^(*) plutôt que des trucs en VBA et hors VBA (le dico) que tu maîtrises mal, de ton propre aveu.

(*) Quand on programme en VBA pour Excel, on pense Excel avant de penser VBA (et on utilise les ressources d'Excel => tableaux structurés, fonction EVALUATE, Application.worksheetFunction, ...) ;)

PS: En regardant ton classeur, j'ai remarqué que tu n'avais pas l'option "déclaration des variables obligatoires" => je ne peux que te conseiller d'aller cocher cette option (voir mon billet à ce sujet)

1 pièce(s) jointe(s)

Merci infiniment pour ton aide.

Ton code répond parfaitement à mon besoin.

Sauf que l'objectif du UserForm comme j'ai déjà dit c'est envoyé des e-mails (en remplissant un doc Word modèle) et calculer le taux des e-mails envoyés par catégorie. Apres vos modifications, ma commande "Envoyer l'email" ne marche plus, je n'ai pas arrivé à faire les modifs nécessaires.

Voici le code de la commende "Envoyer l'email"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub Cmd_injecter_Click()
    Dim WordApp As Object
    Dim i As Integer, nomDossier As String, cheminDos As String, doss As String, ligne_grille As Integer
    Dim Fichier As String, Spec As String, DLV As Long
 
    DLV = Sheets("P9A").Cells(Rows.Count, 1).End(xlUp).Row - 1 
 
    If NoSlct Then
    MsgBox "Vous devez sélectionner au moins une ligne", vbOKOnly, "Contrôle de saisie"
     Else
    If MsgBox("Confirmez-vous la redaction du courrier de l'amiante", vbYesNo, "Courrier de l'amiante") = vbNo Then Exit Sub
 
    '// création application Word
    Set WordApp = CreateObject("word.application")
    WordApp.Visible = True
    '// injection lignes dans document Word
    With Me.Lbx_grille
        For i = 1 To .ListCount
            If .Selected(i) Then
            ligne_grille = tb_lignes_grille(i)
            cheminDos = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
 
            Fichier = Sheets("P9A").Range("A" & ligne_grille)
            Spec = Sheets("P9A").Range("B" & ligne_grille)
            doss = "Client P9A " & Fichier & "-" & Spec
 
            CreationRepertoire cheminDos, doss
            Call AmianteWord(WordApp, ligne_grille)
            envoyerCour (ligne_grille)
            Sheets("P9A").Range("F" & ligne_grille) = "OK"
            Sheets("TBD").Range("H4") = ""
              Sheets("TBD").Range("H4").FormulaR1C1 = "=COUNTIF(P9A!C[-2],""OK"")"
               Sheets("TBD").Range("H4") = (Sheets("TBD").Range("H4") / DLV)
            .Selected(i) = False
            End If
        Next i
 
    End With
 
    '// fermeture application Word
 WordApp.Quit
 
    '// Message de fin
    MsgBox "le courrier de l'amiante a été généré", vbInformation, "Confirmation"
    Unload Me
    End If
End Sub

Code:

1
2
3
4
5
6
7
8
9
Function NoSlct() As Boolean
    Dim i%
    With Lbx_grille
        For i = 0 To .ListCount - 1
            If .Selected(i) Then Exit Function
        Next i
    End With
    NoSlct = True
End Function

et voici le code des fonctions AmianteWord(WordApp, ligne_grille) et envoyerCour (ligne_grille)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub AmianteWord(WordApp As Object, ligne As Integer)
    Dim WordDoc As Object, champ As Object
    Dim Nom As String, nom_fichier As String
    Dim cell As Range, référence As String
 
    nom_fichier = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\Courrier amiante\Courrier initial amiante (DTA).docx"
    Set WordDoc = WordApp.Documents.Open(nom_fichier)
    If Err <> 0 Then MsgBox "Erreur ouverture document modèle --  " & Err.Description: Exit Sub
 
    '// initialisation champs de fusion
    WordDoc.Fields.Update
 
'WordDoc.Bookmarks.Delete
 
  ' WordDoc.Bookmarks("Signature").Update
 
    '// remplissage champs de fusion
    For Each champ In WordDoc.Fields
        'Si champ de fusion ...............................
        If champ.Type = 59 Then
 
            'suppression guillemets champ de fusion
            Nom = Replace(champ.Result, Chr(171), ""): Nom = Replace(Nom, Chr(187), "")
 
            'remplissage champ de fusion à partir de la valeur de la colonne à laquelle le nom fait référence
            Set cell = [P9AFeuille].Rows(1).Find(Nom, LookAt:=xlWhole)
            If Not cell Is Nothing Then champ.Result.Text = cell.Offset(ligne - 1)
        End If
    Next champ
    '// sauvegarde et fermeture document
 
   Dim Dossier As String, Fichier As String, chemin As String, Spec As String, doss As String
 
            Fichier = Sheets("P9A").Range("A" & ligne)
            Spec = Sheets("P9A").Range("B" & ligne)
            doss = "Client P9A " & Fichier & "-" & Spec
 
chemin = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\" & doss
 
'Word
 WordDoc.SaveAs Filename:=chemin & "\Courrier de DTA" & ".docx"
 
 
  'PDF
   WordDoc.ExportAsFixedFormat OutputFileName:= _
        chemin & "\Courrier de DTA" & ".pdf", ExportFormat:= _
        17, OpenAfterExport:=False, OptimizeFor:= _
        0, Range:=0, From:=1, To:=1, _
        Item:=0, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=0, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
'WordDoc.SaveChanges = False
    WordDoc.Close
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub envoyerCour(ligne As Integer)
 
Dim copie As String, xOutApp As Object, OutMail As Object, xMailItem As String
Dim xMailBody As String, TypeOffre As String, NomClient As String, Destinataire As String, NomInterClient As String
Dim myAttachments As Outlook.Attachments
 
'Recuperation des données
NomClient = Sheets("P9A").Range("A" & ligne)
Destinataire = Sheets("P9A").Range("e" & ligne)
 
Set xOutApp = CreateObject("Outlook.Application")
        Set OutMail = xOutApp.CreateItem(0)
 
        copie = "cfg@yahoo.com"
 
        Set myAttachments = OutMail.Attachments
        xMailItem = "Contrat CFA " & NomClient
        xMailBody = "Bonjour ," & "<br>" & "<br>" & _
        "Vous trouverez ci-joint :" & "<br>" & "<br>" & _
        "<ul>" & "<li>" & "Le courrier de DTA à nous retourner signé" & "</li>" & "</ul>" & _
       "Vous en souhaitant bonne réception," & "<br>" & "<br>" & "Cordialement,"
    On Error Resume Next
        With OutMail
            .Display
            .To = Destinataire
            .CC = copie
            .Subject = xMailItem
            .HTMLBody = xMailBody & .HTMLBody
            'demande AR
.OriginatorDeliveryReportRequested = True
'demande confirmation de lecture
.ReadReceiptRequested = True
 
        End With
        Dim chemin As String
 
 Dim Dossier As String, Fichier As String, Spec As String, doss As String
 
Fichier = Sheets("P9A").Range("A" & ligne)
Spec = Sheets("P9A").Range("B" & ligne)
doss = "Client P9A " & Fichier & "-" & Spec
 
chemin = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\" & doss
       myAttachments.Add Source:=chemin & "\Courrier de DTA.pdf"
End Sub

Tu peux remarquer qu'au départ, j'ai écrit des fonctions par catégorie des clients (P9A par exemple) car j'avais des userform différents, comment je dois faire maintenant?

Est ce que c'est possible d'ajouter dans l'UserForm un textbox pour rechercher un client?

Merci infiniment une autre fois pour ton aide :)

11/08/2021, 10h56
Pierre Fauconnier

Comme je l'ai dit, ma solution fournit un cadre de travail et indique une direction à prendre pour programmer ton application.

A l'ouverture du userform, on passer à la propriété TableName le nom du tableau que l'on utilise. Dès lors, on peut utiliser cette valeur pour déterminer la suite du travail en la passant en argument aux procédures et fonctions chargées de traiter le choix de l'utilisateur.

Mais pour éviter trop de transformations dans ton code, tu peux bien sûr continuer à utiliser plusieurs userforms, que tu programmeras comme je l'ai montré avec USF. A toi de voir si tu veux dès maintenant avoir un code plus solide, plus stable et maintenable ou si, pour une raison qui t'est personnelle, tu souhaites utiliser ton code pour la suite du traitement.

Le fait de n'utiliser qu'un userform te permet de ne développer ton code qu'une fois, en sortant du code les parties "en dur" et en les y faisant rentrer via les arguments de procédure et de fonction.
11/08/2021, 11h03
Menalm11

1 pièce(s) jointe(s)

Non je voudrai utiliser ta solution. En PJ voici mon fichier, est ce que tu peux me faire ou me monter les modifs à faire pour que mon code marche.

Merci pour ton aide.

Pièce jointe 603111