|
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 !
ANNUAIRE
Information sur la source
Description
Bon voila un annuaire. Il est tres bourrin. Comme je ne sais pas faire, il enregister tout dans c:\ANNUAIRE\
Source
-
- Private Type fiche
- nom As String
- prenom As String
- tel As String
- adresse As String
- email As String
- End Type
-
- Const nbMaxPersonnes As Integer = 100
-
- Dim CurFile As String
- Dim TabFiche(1 To nbMaxPersonnes) As fiche
- Dim nbTabFiche As Integer
-
- Dim TabRecherche(1 To 5 * nbMaxPersonnes) As Integer
- Dim nbTabRecherche As Integer
- Dim iTabRecherche As Integer
-
- Public Sub SelectionDuBonRepertoire(Lecteur As String)
- ChDir Lecteur
- SelectRep "ANNUAIRE"
- SelectRep "DataAnnuaire"
- End Sub
-
-
- Public Sub SetAbout()
- Dim Text1 As String
- Dim Text2 As String
- Dim Text3 As String
- Dim Text4 As String
- Dim Text5 As String
-
- Text1 = "-------------------------"
- Text2 = "Annuaire"
- Text3 = "-------------------------"
- Text4 = "JCDjcd"
- Text5 = "www.vbfrance.com"
-
- LabelAbout.Caption = Text1 & Chr(13) & Text2 & Chr(13) & Text3 & Chr(13) & Text4 & Chr(13) & Text5
-
- End Sub
-
- Public Sub ClearRecherche()
- ButtonPrev.Enabled = False
- ButtonNext.Enabled = False
- nbTabRecherche = 0
- ComboBoxRecherche.Text = ""
- LabelNbElement.Caption = "0 / 0"
- End Sub
-
- Public Sub ClearTextInput()
- TextBoxNom.Text = ""
- TextBoxPrenom.Text = ""
- TextBoxTel.Text = ""
- TextBoxAdresse.Text = ""
- TextBoxEmail.Text = ""
- End Sub
-
-
- Public Sub ClearFiche()
-
- LabelNomFiche.Caption = ""
- LabelPrenomFiche.Caption = ""
- LabelTelFiche.Caption = ""
- LabelAdresseFiche.Caption = ""
- LabelEmailFiche.Caption = ""
-
- End Sub
-
- Public Sub SelectRep(rep As String)
- Dim r As String
- r = Dir(rep, vbDirectory)
- If r = "" Then
- MkDir rep
- End If
- ChDir rep
- End Sub
-
- Public Function GetAllUsers()
-
- Dim file As String
- Dim numberUser As Integer
-
- ListBoxUser.Clear
-
- numberUser = 0
- file = Dir("*.anu", vbNormal)
-
- While Not file = ""
- numberUser = numberUser + 1
- ListBoxUser.AddItem (file)
- file = Dir
- Wend
-
- GetAllUsers = numberUser
-
- End Function
-
-
- Private Sub ButonSelectionnerPersonne_Click()
-
- Dim f As fiche
-
- If ListBoxPersonne.ListIndex = -1 Then
- Exit Sub
- End If
- f = TabFiche(ListBoxPersonne.ListIndex + 1)
-
- LabelNomFiche.Caption = f.nom
- LabelPrenomFiche.Caption = f.prenom
- LabelTelFiche.Caption = f.tel
- LabelAdresseFiche.Caption = f.adresse
- LabelEmailFiche.Caption = f.email
-
- End Sub
-
- Private Sub ButtonGo_Click()
- Dim f As fiche
- Dim a As Integer
-
- If nbTabRecherche = 0 Then
- Exit Sub
- End If
-
- a = TabRecherche(iTabRecherche)
- f = TabFiche(a)
-
- ListBoxPersonne.ListIndex = a - 1
-
- LabelNomFiche.Caption = f.nom
- LabelPrenomFiche.Caption = f.prenom
- LabelTelFiche.Caption = f.tel
- LabelAdresseFiche.Caption = f.adresse
- LabelEmailFiche.Caption = f.email
- End Sub
-
- Private Sub ButtonLancerRecherche_Click()
- Dim i As Integer, j As Integer
- Dim s As String
-
-
- s = ComboBoxRecherche.Text
-
- If s = "" Then
- ClearRecherche
- Exit Sub
- End If
-
- ComboBoxRecherche.AddItem (s)
-
- nbTabRecherche = 0
- i = 1
- j = 1
- While i <= nbTabFiche
- If (Not (InStr(1, TabFiche(i).adresse, s, vbTextCompare) = 0)) Or (Not (InStr(1, TabFiche(i).email, s, vbTextCompare) = 0)) Or (Not (InStr(1, TabFiche(i).nom, s, vbTextCompare) = 0)) Or (Not (InStr(1, TabFiche(i).prenom, s, vbTextCompare) = 0)) Or (Not (InStr(1, TabFiche(i).tel, s, vbTextCompare) = 0)) Then
-
- TabRecherche(j) = i
- j = j + 1
- nbTabRecherche = nbTabRecherche + 1
- End If
- i = i + 1
- Wend
-
- ButtonPrev.Enabled = False
- If nbTabRecherche = 0 Then
- ButtonNext.Enabled = False
- LabelNbElement.Caption = "0 / 0"
- Else
- If nbTabRecherche > 1 Then
- ButtonNext.Enabled = True
- Else
- ButtonNext.Enabled = False
- End If
- iTabRecherche = 1
- ButtonGo_Click
- LabelNbElement.Caption = "1 / " & nbTabRecherche
-
- End If
-
- End Sub
-
- Private Sub ButtonNewPersonne_Click()
-
- Dim f As fiche
-
- If CurFile = "" Or nbTabFiche = nbMaxPersonnes Then
- Exit Sub
- End If
-
- If TextBoxNom.Text = "" Or TextBoxPrenom = "" Then
- Exit Sub
- End If
-
- f.nom = TextBoxNom.Text
- f.prenom = TextBoxPrenom.Text
-
- If TextBoxTel.Text = "" Then
- f.tel = " "
- Else
- f.tel = TextBoxTel.Text
- End If
-
- If TextBoxAdresse.Text = "" Then
- f.adresse = " "
- Else
- f.adresse = TextBoxAdresse.Text
- End If
-
- If TextBoxEmail.Text = "" Then
- f.email = " "
- Else
- f.email = TextBoxEmail.Text
- End If
-
- Open CurFile For Random As #1
- Seek #1, nbTabFiche + 1
- Put #1, , f
- Close #1
- ClearTextInput
- GetAllPersonne
- End Sub
-
-
-
- Private Sub ButtonNext_Click()
-
- If iTabRecherche = nbTabRecherche - 1 Then
- ButtonNext.Enabled = False
- End If
-
- iTabRecherche = iTabRecherche + 1
- LabelNbElement.Caption = iTabRecherche & " / " & nbTabRecherche
-
- ButtonGo_Click
-
- If iTabRecherche > 1 Then
- ButtonPrev.Enabled = True
- Else
- ButtonPrev.Enabled = False
- End If
-
- End Sub
-
- Public Function isNameFileValide(s As String)
-
- If Not InStr(1, s, ".") = 0 Then
- isNameFileValide = False
- Exit Function
- End If
-
- If (Not InStr(1, s, ">") = 0) And (Not InStr(1, s, "<") = 0) Then
- isNameFileValide = False
- Exit Function
- End If
-
- If (Not InStr(1, s, "/") = 0) And (Not InStr(1, s, "\") = 0) Then
- isNameFileValide = False
- Exit Function
- End If
-
-
- If Not InStr(1, s, ":") = 0 Then
- isNameFileValide = False
- Exit Function
- End If
-
- If Not InStr(1, s, "*") = 0 And (Not InStr(1, s, "?") = 0) Then
- isNameFileValide = False
- Exit Function
- End If
-
- If Not InStr(1, s, "|") = 0 Then
- isNameFileValide = False
- Exit Function
- End If
-
- If Not InStr(1, s, Chr(34)) = 0 Then ' Chr(34) = "
- isNameFileValide = False
- Exit Function
- End If
-
- isNameFileValide = True
- Exit Function
-
- End Function
-
- Private Sub ButtonNouveau_Click()
- Dim NewName As String
-
- NewName = TextBoxNewName.Text
-
- If (Not (NewName = "")) And isNameFileValide(NewName) Then
- Open NewName & ".anu" For Output As #1
- Close #1
- ListBoxUser.AddItem (NewName & ".anu")
- TextBoxNewName.Text = ""
- TextBoxNewName.SetFocus
- End If
- End Sub
-
- Public Function GetAllPersonne()
- Dim f As fiche
- Dim nbPersonne As Integer
-
- If CurFile = "" Then
- Exit Function
- End If
-
- ClearRecherche
-
- ListBoxPersonne.Clear
- Open CurFile For Random As #1
- Get #1, , f
- nbTabFiche = 0
- nbPersonne = 0
- While Not f.email = ""
- nbPersonne = nbPersonne + 1
- nbTabFiche = nbTabFiche + 1
- ListBoxPersonne.AddItem (f.nom & " " & f.prenom)
- TabFiche(nbTabFiche) = f
- Get #1, , f
- Wend
- Close #1
- GetAllPersonne = nbPersonne
- End Function
-
- Private Sub ButtonPrev_Click()
-
- iTabRecherche = iTabRecherche - 1
- LabelNbElement.Caption = iTabRecherche & " / " & nbTabRecherche
-
- ButtonGo_Click
-
- If iTabRecherche = 1 Then
- ButtonPrev.Enabled = False
- End If
-
- If iTabRecherche < nbRecherche Then
- ButtonNext.Enabled = False
- Else
- ButtonNext.Enabled = True
- End If
-
- End Sub
-
- Private Sub ButtonSelectionner_Click()
- If ListBoxUser.ListIndex = -1 Or ListBoxUser.Value = "" Then
- Exit Sub
- End If
- CurFile = ListBoxUser.Text
- FrameName.Caption = CurFile & " : "
- GetAllPersonne
- End Sub
-
- Private Sub ButtonSupprimer_Click()
- Dim Selection As String
-
- If ListBoxUser.ListIndex = -1 Then
- Exit Sub
- End If
-
- ClearTextInput
- ClearFiche
- ClearRecherche
- CurFile = ""
- ListBoxPersonne.Clear
-
- Selection = ListBoxUser.Value
- If Not Selection = "" Then
- Kill Selection
- GetAllUsers
- End If
- End Sub
-
- Private Sub ButtonSupprimerPersonne_Click()
- Dim f As fiche
- Dim i, a As Integer
-
- a = ListBoxPersonne.ListIndex
- If a = -1 Then
- Exit Sub
- End If
-
- a = a + 1
-
- Kill CurFile
- Open CurFile For Random As #1
-
- i = 1
- While i < a
- Put #1, , TabFiche(i)
- i = i + 1
- Wend
-
- i = a + 1
- While i <= nbTabFiche
- Put #1, , TabFiche(i)
- i = i + 1
- Wend
-
- Close #1
-
- If Not GetAllPersonne() = 0 Then
- ListBoxPersonne.SetFocus
- ListBoxPersonne.ListIndex = 0
- End If
- End Sub
-
- Private Sub ButtonUpDate_Click()
- GetAllUsers
- End Sub
-
- Private Sub ButtonUpDatePersonne_Click()
- GetAllPersonne
- End Sub
-
-
- Private Sub FrameName_Click()
-
- End Sub
-
-
-
- Private Sub ListBoxPersonne_Change()
- ClearFiche
- End Sub
-
- Private Sub ListBoxPersonne_Click()
- ButonSelectionnerPersonne_Click
- End Sub
-
-
- Private Sub ListBoxUser_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
- ButtonSelectionner_Click
- End Sub
-
-
- Private Sub UserForm_Initialize()
-
-
- Dim nbUser As Integer
-
- CurFile = ""
-
- SelectionDuBonRepertoire ("c:\")
-
-
- SetAbout
- GetAllUsers
-
- ButtonPrev.Enabled = False
- ButtonNext.Enabled = False
- nbTabRecherche = 0
-
- End Sub
Private Type fiche
nom As String
prenom As String
tel As String
adresse As String
email As String
End Type
Const nbMaxPersonnes As Integer = 100
Dim CurFile As String
Dim TabFiche(1 To nbMaxPersonnes) As fiche
Dim nbTabFiche As Integer
Dim TabRecherche(1 To 5 * nbMaxPersonnes) As Integer
Dim nbTabRecherche As Integer
Dim iTabRecherche As Integer
Public Sub SelectionDuBonRepertoire(Lecteur As String)
ChDir Lecteur
SelectRep "ANNUAIRE"
SelectRep "DataAnnuaire"
End Sub
Public Sub SetAbout()
Dim Text1 As String
Dim Text2 As String
Dim Text3 As String
Dim Text4 As String
Dim Text5 As String
Text1 = "-------------------------"
Text2 = "Annuaire"
Text3 = "-------------------------"
Text4 = "JCDjcd"
Text5 = "www.vbfrance.com"
LabelAbout.Caption = Text1 & Chr(13) & Text2 & Chr(13) & Text3 & Chr(13) & Text4 & Chr(13) & Text5
End Sub
Public Sub ClearRecherche()
ButtonPrev.Enabled = False
ButtonNext.Enabled = False
nbTabRecherche = 0
ComboBoxRecherche.Text = ""
LabelNbElement.Caption = "0 / 0"
End Sub
Public Sub ClearTextInput()
TextBoxNom.Text = ""
TextBoxPrenom.Text = ""
TextBoxTel.Text = ""
TextBoxAdresse.Text = ""
TextBoxEmail.Text = ""
End Sub
Public Sub ClearFiche()
LabelNomFiche.Caption = ""
LabelPrenomFiche.Caption = ""
LabelTelFiche.Caption = ""
LabelAdresseFiche.Caption = ""
LabelEmailFiche.Caption = ""
End Sub
Public Sub SelectRep(rep As String)
Dim r As String
r = Dir(rep, vbDirectory)
If r = "" Then
MkDir rep
End If
ChDir rep
End Sub
Public Function GetAllUsers()
Dim file As String
Dim numberUser As Integer
ListBoxUser.Clear
numberUser = 0
file = Dir("*.anu", vbNormal)
While Not file = ""
numberUser = numberUser + 1
ListBoxUser.AddItem (file)
file = Dir
Wend
GetAllUsers = numberUser
End Function
Private Sub ButonSelectionnerPersonne_Click()
Dim f As fiche
If ListBoxPersonne.ListIndex = -1 Then
Exit Sub
End If
f = TabFiche(ListBoxPersonne.ListIndex + 1)
LabelNomFiche.Caption = f.nom
LabelPrenomFiche.Caption = f.prenom
LabelTelFiche.Caption = f.tel
LabelAdresseFiche.Caption = f.adresse
LabelEmailFiche.Caption = f.email
End Sub
Private Sub ButtonGo_Click()
Dim f As fiche
Dim a As Integer
If nbTabRecherche = 0 Then
Exit Sub
End If
a = TabRecherche(iTabRecherche)
f = TabFiche(a)
ListBoxPersonne.ListIndex = a - 1
LabelNomFiche.Caption = f.nom
LabelPrenomFiche.Caption = f.prenom
LabelTelFiche.Caption = f.tel
LabelAdresseFiche.Caption = f.adresse
LabelEmailFiche.Caption = f.email
End Sub
Private Sub ButtonLancerRecherche_Click()
Dim i As Integer, j As Integer
Dim s As String
s = ComboBoxRecherche.Text
If s = "" Then
ClearRecherche
Exit Sub
End If
ComboBoxRecherche.AddItem (s)
nbTabRecherche = 0
i = 1
j = 1
While i <= nbTabFiche
If (Not (InStr(1, TabFiche(i).adresse, s, vbTextCompare) = 0)) Or (Not (InStr(1, TabFiche(i).email, s, vbTextCompare) = 0)) Or (Not (InStr(1, TabFiche(i).nom, s, vbTextCompare) = 0)) Or (Not (InStr(1, TabFiche(i).prenom, s, vbTextCompare) = 0)) Or (Not (InStr(1, TabFiche(i).tel, s, vbTextCompare) = 0)) Then
TabRecherche(j) = i
j = j + 1
nbTabRecherche = nbTabRecherche + 1
End If
i = i + 1
Wend
ButtonPrev.Enabled = False
If nbTabRecherche = 0 Then
ButtonNext.Enabled = False
LabelNbElement.Caption = "0 / 0"
Else
If nbTabRecherche > 1 Then
ButtonNext.Enabled = True
Else
ButtonNext.Enabled = False
End If
iTabRecherche = 1
ButtonGo_Click
LabelNbElement.Caption = "1 / " & nbTabRecherche
End If
End Sub
Private Sub ButtonNewPersonne_Click()
Dim f As fiche
If CurFile = "" Or nbTabFiche = nbMaxPersonnes Then
Exit Sub
End If
If TextBoxNom.Text = "" Or TextBoxPrenom = "" Then
Exit Sub
End If
f.nom = TextBoxNom.Text
f.prenom = TextBoxPrenom.Text
If TextBoxTel.Text = "" Then
f.tel = " "
Else
f.tel = TextBoxTel.Text
End If
If TextBoxAdresse.Text = "" Then
f.adresse = " "
Else
f.adresse = TextBoxAdresse.Text
End If
If TextBoxEmail.Text = "" Then
f.email = " "
Else
f.email = TextBoxEmail.Text
End If
Open CurFile For Random As #1
Seek #1, nbTabFiche + 1
Put #1, , f
Close #1
ClearTextInput
GetAllPersonne
End Sub
Private Sub ButtonNext_Click()
If iTabRecherche = nbTabRecherche - 1 Then
ButtonNext.Enabled = False
End If
iTabRecherche = iTabRecherche + 1
LabelNbElement.Caption = iTabRecherche & " / " & nbTabRecherche
ButtonGo_Click
If iTabRecherche > 1 Then
ButtonPrev.Enabled = True
Else
ButtonPrev.Enabled = False
End If
End Sub
Public Function isNameFileValide(s As String)
If Not InStr(1, s, ".") = 0 Then
isNameFileValide = False
Exit Function
End If
If (Not InStr(1, s, ">") = 0) And (Not InStr(1, s, "<") = 0) Then
isNameFileValide = False
Exit Function
End If
If (Not InStr(1, s, "/") = 0) And (Not InStr(1, s, "\") = 0) Then
isNameFileValide = False
Exit Function
End If
If Not InStr(1, s, ":") = 0 Then
isNameFileValide = False
Exit Function
End If
If Not InStr(1, s, "*") = 0 And (Not InStr(1, s, "?") = 0) Then
isNameFileValide = False
Exit Function
End If
If Not InStr(1, s, "|") = 0 Then
isNameFileValide = False
Exit Function
End If
If Not InStr(1, s, Chr(34)) = 0 Then ' Chr(34) = "
isNameFileValide = False
Exit Function
End If
isNameFileValide = True
Exit Function
End Function
Private Sub ButtonNouveau_Click()
Dim NewName As String
NewName = TextBoxNewName.Text
If (Not (NewName = "")) And isNameFileValide(NewName) Then
Open NewName & ".anu" For Output As #1
Close #1
ListBoxUser.AddItem (NewName & ".anu")
TextBoxNewName.Text = ""
TextBoxNewName.SetFocus
End If
End Sub
Public Function GetAllPersonne()
Dim f As fiche
Dim nbPersonne As Integer
If CurFile = "" Then
Exit Function
End If
ClearRecherche
ListBoxPersonne.Clear
Open CurFile For Random As #1
Get #1, , f
nbTabFiche = 0
nbPersonne = 0
While Not f.email = ""
nbPersonne = nbPersonne + 1
nbTabFiche = nbTabFiche + 1
ListBoxPersonne.AddItem (f.nom & " " & f.prenom)
TabFiche(nbTabFiche) = f
Get #1, , f
Wend
Close #1
GetAllPersonne = nbPersonne
End Function
Private Sub ButtonPrev_Click()
iTabRecherche = iTabRecherche - 1
LabelNbElement.Caption = iTabRecherche & " / " & nbTabRecherche
ButtonGo_Click
If iTabRecherche = 1 Then
ButtonPrev.Enabled = False
End If
If iTabRecherche < nbRecherche Then
ButtonNext.Enabled = False
Else
ButtonNext.Enabled = True
End If
End Sub
Private Sub ButtonSelectionner_Click()
If ListBoxUser.ListIndex = -1 Or ListBoxUser.Value = "" Then
Exit Sub
End If
CurFile = ListBoxUser.Text
FrameName.Caption = CurFile & " : "
GetAllPersonne
End Sub
Private Sub ButtonSupprimer_Click()
Dim Selection As String
If ListBoxUser.ListIndex = -1 Then
Exit Sub
End If
ClearTextInput
ClearFiche
ClearRecherche
CurFile = ""
ListBoxPersonne.Clear
Selection = ListBoxUser.Value
If Not Selection = "" Then
Kill Selection
GetAllUsers
End If
End Sub
Private Sub ButtonSupprimerPersonne_Click()
Dim f As fiche
Dim i, a As Integer
a = ListBoxPersonne.ListIndex
If a = -1 Then
Exit Sub
End If
a = a + 1
Kill CurFile
Open CurFile For Random As #1
i = 1
While i < a
Put #1, , TabFiche(i)
i = i + 1
Wend
i = a + 1
While i <= nbTabFiche
Put #1, , TabFiche(i)
i = i + 1
Wend
Close #1
If Not GetAllPersonne() = 0 Then
ListBoxPersonne.SetFocus
ListBoxPersonne.ListIndex = 0
End If
End Sub
Private Sub ButtonUpDate_Click()
GetAllUsers
End Sub
Private Sub ButtonUpDatePersonne_Click()
GetAllPersonne
End Sub
Private Sub FrameName_Click()
End Sub
Private Sub ListBoxPersonne_Change()
ClearFiche
End Sub
Private Sub ListBoxPersonne_Click()
ButonSelectionnerPersonne_Click
End Sub
Private Sub ListBoxUser_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ButtonSelectionner_Click
End Sub
Private Sub UserForm_Initialize()
Dim nbUser As Integer
CurFile = ""
SelectionDuBonRepertoire ("c:\")
SetAbout
GetAllUsers
ButtonPrev.Enabled = False
ButtonNext.Enabled = False
nbTabRecherche = 0
End Sub
Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
Télécharger le zip
Sources de la même categorie
Commentaires et avis
|
|