|
Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
LISTE DES EMAILS, NUMÉRO DE TÉLÉPHONNES DES TRAVAILLEURS
Information sur la source
Description
Cette source propose une manière simple de rechecher le numéro de telephone fixe ou mobile d'un collegue dans une entreprise, elle faite en VBA et utilise les formulaires d'Excel, Lisbox et conbobox avec possibilité d'ajouter, modifier ou supprimer un enrégistrement.
Source
- Private Sub fermer_Click()
- With ActiveWorkbook
- .RunAutoMacros xlAutoClose
- .Close
- End With
- End Sub
-
- Private Sub Label_Rt_Menu_Click()
- Unload Me
- us1.Show modeless
- End Sub
-
- Private Sub OptionCell_Click()
- filtre
- End Sub
-
- Private Sub OptionEmail_Click()
- filtre
- End Sub
-
- Private Sub OptionExt_Click()
- filtre
- End Sub
-
- Private Sub UserForm_initialize()
- Worksheets("Famille").Activate
- [b3:i1000].Sort key1:=[b3] ' Tri la BD
- ' Me.ChoixNom.List = Application.Transpose(Range([b3], [B65000].End(xlUp)))
- End Sub
- Private Sub nom_Change()
- filtre
- End Sub
- ''''''''''''''''''''''''''''''''''''''''''''''''''''''
- 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 = "Extention 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 ' Fonction
-
- Me.ListBoxdon.List(i, 3) = c.Offset(0, 4).Value ' Adresse
-
-
- Set c = Range("b:b").FindNext(c)
- i = 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 ' Fonction
-
- Me.ListBoxdon.List(i, 3) = c.Offset(0, 5).Value ' Adresse
-
-
- 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 "
- 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 ' Fonction
-
- Me.ListBoxdon.List(i, 3) = c.Offset(0, 6).Value ' Adresse
-
- 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
-
- Private Sub UserForm_Terminate()
- With ActiveWorkbook
- .RunAutoMacros xlAutoClose
- .Close
- End With
- End Sub
Private Sub fermer_Click()
With ActiveWorkbook
.RunAutoMacros xlAutoClose
.Close
End With
End Sub
Private Sub Label_Rt_Menu_Click()
Unload Me
us1.Show modeless
End Sub
Private Sub OptionCell_Click()
filtre
End Sub
Private Sub OptionEmail_Click()
filtre
End Sub
Private Sub OptionExt_Click()
filtre
End Sub
Private Sub UserForm_initialize()
Worksheets("Famille").Activate
[b3:i1000].Sort key1:=[b3] ' Tri la BD
' Me.ChoixNom.List = Application.Transpose(Range([b3], [B65000].End(xlUp)))
End Sub
Private Sub nom_Change()
filtre
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 = "Extention 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 ' Fonction
Me.ListBoxdon.List(i, 3) = c.Offset(0, 4).Value ' Adresse
Set c = Range("b:b").FindNext(c)
i = 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 ' Fonction
Me.ListBoxdon.List(i, 3) = c.Offset(0, 5).Value ' Adresse
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 "
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 ' Fonction
Me.ListBoxdon.List(i, 3) = c.Offset(0, 6).Value ' Adresse
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
Private Sub UserForm_Terminate()
With ActiveWorkbook
.RunAutoMacros xlAutoClose
.Close
End With
End Sub
Conclusion
Commencez par desactiver la securité des macro en excel, la suite sera facile Mot de Passee pour la modification et l'ajout : "nizebel"
Historique
- 30 mai 2008 07:55:24 :
- Changement de la Capture
- 30 mai 2008 07:56:54 :
- Changement de la Capture
- 30 mai 2008 08:00:29 :
- Chengement de la Capture
- 30 mai 2008 09:34:33 :
- Pris en compte du conseil de bigfish_le vrai
Modification de Sub Filtre()
- 03 juin 2008 11:35:58 :
- Code
- 03 juin 2008 11:37:48 :
- code
- 13 juin 2008 08:49:13 :
- Modification
Sources de la même categorie
Sources en rapport avec celle ci
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
tri de listbox [ par Oups ]
qu'elle et la methode de trie la plus approprié dans d'une listbox qui charge des enregistrements ayant un chiffre devant chaque lignes ? quand je cha
listbox vba [ par anfo ]
Bonjour!Je travaille avec Access. J'ai mis sur mon formulaire, un contrôle ActiveX listBox. Lorsque je met mon formulaire en mode formulaire, Il y a u
listbox [ par anfo ]
Bonjour!Je travaille avec Access. J'ai mis sur mon formulaire, un contrôle ActiveX listBox. Lorsque je met mon formulaire en mode formulaire, Il y a u
access: selection auto d'un item ds listbox [ par SamLJ ]
Je vais dc vs expliquer mon pb soyez attentif :-)g une base de donnée composée de 3 tables:"logiciel","utilisateur", et "logiciel-utilisateur"( cette
répérer l'évenement Tri (A-Z) ou Tri (Z-A) dans un formulaire access [ par tofoli ]
Bonjour,Je chercher a répérer l'évenement Tri (A-Z) ou Tri (Z-A) dans un formulaire access ouvert en mode feuille de données.Je ne trouve rien dans la
tri d'une ListBox [ par dao85 ]
Bonjour à tous et bonne semainePas trop dur le lundi???Moi j'ai un petit souci et je ne sais pas si il éxiste une solution:Voila :Je remplis une listB
Tri dans une ListBox [ par xabi62 ]
Est-ce qu'on peut faire un tri par ordre alphabétique de tous les éléments contenu dans une ListBox.Si oui comment faut-il faire..?????Merci A+xabi
info dans BDD [ par noob ]
bonjour,voila mon probleme. J'ai un formulaire de demande d'info (nom, prenom, tel .....) que l'utilisateur rempli. Puis il valide et se retrouve deva
pbl tri listbox [ par kdavtodie ]
Bonjour,j ai un ptit souci sur l affichage d une listbox qui est le résultat d une comparaison avec une autre listbox, donc ces deux la on une proprié
Bug Clic Formulaire Access [ par ozar ]
Bonjour,J'ai un formulaire Access avec plusieurs listbox, Combo et text . Lorsque je clic sur un listbox, il arrive qu'après je ne puisse plus dutout
|
Téléchargements
Logiciels à télécharger sur le même thème :
|