LISTE DES EMAILS, NUMÉRO DE TÉLÉPHONNES DES TRAVAILLEURS
bigfish_le vrai
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
-
30 mai 2008 à 00:01
ferdhy Messages postés 9 Date d'inscription vendredi 14 avril 2006 Statut Membre Dernière intervention 27 mai 2009 - 13 juin 2008 à 08:45
ferdhy Messages postés 9 Date d'inscription vendredi 14 avril 2006 Statut Membre Dernière intervention 27 mai 2009 - 13 juin 2008 à 08:45
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/46811-liste-des-emails-numero-de-telephonnes-des-travailleurs
https://codes-sources.commentcamarche.net/source/46811-liste-des-emails-numero-de-telephonnes-des-travailleurs
13 juin 2008 à 08:45
Worksheets("Famille").Activate
[A3:h1000].Sort key1:=[b3] ' Tri la BD
Me.ChoixNom.List = Application.Transpose(Range([b3], [b65000].End(xlUp)))
cfs.Visible = False
End Sub
Private Sub ChoixNom_Change()
[b3].Offset(ChoixNom.ListIndex, 0).Select 'on selectione la cellule de l'element
'du combobox
'***********trnasfert des element de la feuille vers le formulaire***********
Me.nom = ActiveCell
Me.Fonction = ActiveCell.Offset(0, 1)
Me.Service = ActiveCell.Offset(0, 2)
Me.Location = ActiveCell.Offset(0, 3)
Me.Extnum = ActiveCell.Offset(0, 4)
Me.celNum = ActiveCell.Offset(0, 5)
Me.Email = ActiveCell.Offset(0, 6)
End Sub
Private Sub b_validation_Click() '************** Valider la Modification
'--- Contrôles
If Me.nom = "" Then
MsgBox "Saisir un nom!"
Me.nom.SetFocus
Exit Sub
End If
'--- Positionnement dans la base
ActiveCell.Offset(0, -1).Select
'--- Transfert Formulaire dans BD du fromulaire à la feuille d'excel
ActiveCell.Offset(0, 1).Value = Me.nom
ActiveCell.Offset(0, 2).Value = Me.Fonction
ActiveCell.Offset(0, 3).Value = Me.Service
ActiveCell.Offset(0, 4).Value = Me.Location
ActiveCell.Offset(0, 5).Value = Me.Extnum
ActiveCell.Offset(0, 6).Value = Me.celNum
ActiveCell.Offset(0, 7).Value = Me.Email
nettoie
Unload Me
End Sub
Sub nettoie() ' *****************Vider les textbox après modification
Me.nom = ""
Me.Fonction = ""
Me.Service = ""
Me.Location = ""
Me.Extnum = ""
Me.celNum = ""
Me.Email = ""
End Sub
6 juin 2008 à 15:25
2 juin 2008 à 09:26
30 mai 2008 à 09:40
j'ai besoin d'aide des personnes comme vous pour améliorer.
Les codes qui ne servent à rien, c'etait pour une autre fonctionalité que j'ai du supprimer, merci
30 mai 2008 à 00:01
ben y a beaucoup a dire :
- code tres peut commenté
- apprend a boucler sur des controles pour simplifier le code
- apprend a te servir de la fonction Select case
- les variables sont pas suffisament declarées d'ailleur pour etre sur de toute les declareés ajoute Option Exlicit en debut de module ou du code d'un objet (feuille, formulaire...)
- pas de bouton pour fermer les formulaires on est obligé d'utiliser la croix
- pas mal de code qui ne sert a rien
- etc
un exemple de simplification :
Pour commencer ton code :
Sub filtre()
If Me.Frame.Controls(0) = True Then
A = 1
ElseIf Me.Frame.Controls(1) = True Then
A = 2
Else: A = 3
End If
Select Case A
Case 1
Me.TextBox5 = "Tel Fixe / Ext Number"
Set c = Range("b:b").Find("*" & Me.nom & "*", LookIn:=xlValues)
If Not c Is Nothing Then
premier = c.Address
i = 0
Me.ListBoxdon.Clear
Do
Me.ListBoxdon.AddItem
Me.ListBoxdon.List(i, 0) = c.Offset(0, 0).Value ' code
Me.ListBoxdon.List(i, 1) = c.Offset(0, 1).Value ' Nom
Me.ListBoxdon.List(i, 2) = c.Offset(0, 2).Value ' Nom
Me.ListBoxdon.List(i, 3) = c.Offset(0, 4).Value ' Fonction
Set c = Range("b:b").FindNext(c)
i = i + 1
f = i - 1
Loop While Not c Is Nothing And c.Address <> premier
End If
Case 2
Me.TextBox5 = "Cell Number"
Set c = Range("b:b").Find("*" & Me.nom & "*", LookIn:=xlValues)
If Not c Is Nothing Then
premier = c.Address
i = 0
Me.ListBoxdon.Clear
Do
Me.ListBoxdon.AddItem
Me.ListBoxdon.List(i, 0) = c.Offset(0, 0).Value ' code
Me.ListBoxdon.List(i, 1) = c.Offset(0, 1).Value ' Nom
Me.ListBoxdon.List(i, 2) = c.Offset(0, 2).Value ' Nom
Me.ListBoxdon.List(i, 3) = c.Offset(0, 5).Value ' Fonction
Set c = Range("b:b").FindNext(c)
i = i + 1
Loop While Not c Is Nothing And c.Address <> premier
End If
Case Else
Me.TextBox5 = "E-Mail Chemaf"
Set c = Range("b:b").Find("*" & Me.nom & "*", LookIn:=xlValues)
If Not c Is Nothing Then
premier = c.Address
i = 0
Me.ListBoxdon.Clear
Do
Me.ListBoxdon.AddItem
Me.ListBoxdon.List(i, 0) = c.Offset(0, 0).Value ' code
Me.ListBoxdon.List(i, 1) = c.Offset(0, 1).Value ' Nom
Me.ListBoxdon.List(i, 2) = c.Offset(0, 2).Value ' Nom
Me.ListBoxdon.List(i, 3) = c.Offset(0, 6).Value ' Fonction
Set c = Range("b:b").FindNext(c)
i = i + 1
Loop While Not c Is Nothing And c.Address <> premier
End If
End Select
End Sub
Puis la version simplifié :
Sub filtre()
Dim MaColonne As Long, c As Range, i As Long
If Me.Frame.Controls(0) = True Then
Me.TextBox5 = "Tel Fixe / Ext Number"
MaColonne = 4
ElseIf Me.Frame.Controls(1) = True Then
Me.TextBox5 = "Cell Number"
MaColonne = 5
Else
Me.TextBox5 = "E-Mail Chemaf"
MaColonne = 6
End If
Set c = Range("b:b").Find("*" & Me.nom & "*", LookIn:=xlValues)
If Not c Is Nothing Then
premier = c.Address
i = 0
Me.ListBoxdon.Clear
Do
Me.ListBoxdon.AddItem
Me.ListBoxdon.List(i, 0) = c.Offset(0, 0).Value ' code
Me.ListBoxdon.List(i, 1) = c.Offset(0, 1).Value ' Nom
Me.ListBoxdon.List(i, 2) = c.Offset(0, 2).Value ' Nom
Me.ListBoxdon.List(i, 3) = c.Offset(0, MaColonne).Value ' Fonction
Set c = Range("b:b").FindNext(c)
i = i + 1
Loop While Not c Is Nothing And c.Address <> premier
End If
End Sub
j'ai pas trop reflechi mais j'entre vois encore plus simple
Honnetement ca ne vaut pas une bonne note mais pour t'encourager je ne la donne pas
^^