Annuaire

Soyez le premier à donner votre avis sur cette source.

Vue 4 427 fois - Téléchargée 338 fois

Description

Bon voila un annuaire.
Il est tres bourrin.

Comme je ne sais pas faire, il enregister tout dans c:\ANNUAIRE\

Source / Exemple :


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

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
1138
Date d'inscription
mardi 10 juin 2003
Statut
Membre
Dernière intervention
25 janvier 2009
4
Ca oui ! (surtout en VB)
Messages postés
721
Date d'inscription
dimanche 10 juin 2001
Statut
Membre
Dernière intervention
27 mars 2011
7
t une brute ...

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.