Gestion d'annuaire téléphonique

Bonjour fronck,

Si le mot saisi n'existe pas dans la bdd, une erreur d'exécution '6' (Dépassement de capacité) s'affiche sur la ligne de code :

        'nombre lignes trouvées
        tabdest = Range("I1").End(xlDown).Row

La même erreur est affichée dans le cas de la recherche par numéro

Bonsoir FINDRH,

Pour plus de détail, des colonnes supplémentaires peuvent être ajoutées à mon tableau.

Pour les données, l'USF peurra servir à saisir (ajout) de nouveaux lignes, de les modifier et bien sur de les supprimer en cas de non besoin de ces données.

Les infos affichés seront les colonnes du nom du "Titulaire" ainsi que ses numeros de "Fixe" et "Mobile" respectifs.

c'est bien ma question.

pour saisir ou modifier ces colonnes supplémentaires sauf si ce sont les résultats de calcul, il faut autant de textbox que de colonnes dans le userform;

Combien faut il en prévoir??

Cordialement .

FINDRH

apt,

Oui j'ai vu qqs bugs aprés envoi et voici une version qui normalement marche avec 3 tests:

un caractère inexistant (w), un existant et plus d'un.

38annuaire-tels2.xlsm (27.46 Ko)

désolé, mais par contre pas de recherche par numéro pour moi.

a+

fronck

FINDRH > En PJ un exemple de ce que pourra être mon annuaire :

fronck > Pour la saisie de lettres, c'est corrigé, mais le problème en cas de saisie de chiffres reste à traiter

Pas de recherche par numéro pour moi.

Ok

Salut apt,

Salut Fronck, FINDRH,

une petite TextBox, peut-être, dans laquelle tu peux taper tout ce que tu veux (texte, chiffres... cohérent avec ta BDD, hein! ) : la macro recherchera dans chaque ligne et colonne de la BDD une correspondance quelconque et t'en fera un tableau dans lequel tu n'auras qu'à cliquer le titulaire voulu pour t'envoyer sur sa ligne.

La recherche commence à partir du 3e caractère encodé. Si tu veux changer cela, c'est ici...

If Len(sItem) >= 3 Then
Private Sub txtREC_Change()
'
Dim tTab, tExtract()
Dim iIdx%, sItem$
'
Application.ScreenUpdating = False
'
tTab = Range("A2:J" & Range("E" & Rows.Count).End(xlUp).Row).Value
sItem = Me.OLEObjects("txtREC").Object.Text
If Len(sItem) = 0 Then
    ActiveWindow.ScrollRow = 1
    Range("A2:J" & Range("E" & Rows.Count).End(xlUp).Row).Interior.Color = xlNone
End If
'
Range("N:P") = ""
Range("O1").Value = "Titulaire"
If Len(sItem) >= 3 Then
    For x = 1 To UBound(tTab, 1)
        For y = 2 To UBound(tTab, 2)
            If InStr(UCase(tTab(x, y)), UCase(sItem)) > 0 Then
                iIdx = iIdx + 1
                ReDim Preserve tExtract(3, iIdx)
                tExtract(0, iIdx - 1) = tTab(x, 1) + 1
                tExtract(1, iIdx - 1) = tTab(x, 5)
                If y <> 5 Then tExtract(2, iIdx - 1) = tTab(x, y)
                Exit For
            End If
        Next
    Next
    If iIdx > 0 Then Range("N2").Resize(iIdx, 3).Value = WorksheetFunction.Transpose(tExtract)
End If
'
Application.ScreenUpdating = True
'
End Sub

A tester en situation réelle et à suivre, sans doute...

A+

29apt-annuaire.xlsm (42.39 Ko)

Bonjour à tous

Avec ta BDD c'est plus clair je vais m'y attaquer

Cordialement

FINDRH

Bonjour curulis57, FINDRH,

curulis57 > j'ai modifié le code pour qu'il prenne en charge la recuperation de plus de des champs :

Private Sub txtREC_Change()
'
    Dim tTab, tExtract()
    Dim iIdx%, sItem$
    '
    Application.ScreenUpdating = False
    '
    tTab = Range("A2:J" & Range("E" & Rows.Count).End(xlUp).Row).Value
    sItem = Me.OLEObjects("txtREC").Object.Text
    If Len(sItem) = 0 Then
        ActiveWindow.ScrollRow = 1
        Range("A2:J" & Range("E" & Rows.Count).End(xlUp).Row).Interior.Color = xlNone
    End If
    '
    Range("N:T") = ""
    Range("O1").Value = "Titulaire"
    '---------
    Range("P1").Value = "Fixe1"
    Range("Q1").Value = "Fixe2"
    Range("R1").Value = "Fixe3"
    Range("S1").Value = "Mobile1"
    Range("T1").Value = "Mobile2"
    '---------
    If Len(sItem) >= 2 Then
        For x = 1 To UBound(tTab, 1)
            For y = 2 To UBound(tTab, 2)
                If InStr(UCase(tTab(x, y)), UCase(sItem)) > 0 Then
                    iIdx = iIdx + 1
                    'ReDim Preserve tExtract(3, iIdx)
                    '---------
                    ReDim Preserve tExtract(7, iIdx)
                    '---------
                    tExtract(0, iIdx - 1) = tTab(x, 1) + 1      ' #
                    tExtract(1, iIdx - 1) = tTab(x, 5)          ' Titulaire
                    '----------
                    tExtract(2, iIdx - 1) = tTab(x, 6)    ' Fixe1
                    tExtract(3, iIdx - 1) = tTab(x, 7)    ' Fixe2
                    tExtract(4, iIdx - 1) = tTab(x, 8)    ' Fixe3
                    tExtract(5, iIdx - 1) = tTab(x, 9)    ' Mobile1
                    tExtract(6, iIdx - 1) = tTab(x, 10)   ' Mobile2
                    '----------
                    If y <> 5 Then tExtract(2, iIdx - 1) = tTab(x, y)
                    Exit For
                End If
            Next
        Next
        'If iIdx > 0 Then Range("N2").Resize(iIdx, 3).Value = WorksheetFunction.Transpose(tExtract)
        '-------
        If iIdx > 0 Then Range("N2").Resize(iIdx, 7).Value = WorksheetFunction.Transpose(tExtract)
    End If
    '
    Application.ScreenUpdating = True
    '
End Sub

FINDRH > Merci d'avance.

Salut apt,

Salut l'équipe,

version améliorée...

Deux feuilles :

- 'BDD' qui contient ton annuaire.

Un double-clic en ligne 1 trie la BDD selon le critère de la colonne cliquée en ordre ASCENDANT alors qu'un clic-droit trie dans l'ordre DESCENDANT.

Public Sub Tri(ByVal iCol%, iIdx%)
'
Range("B1:J" & Range("E" & Rows.Count).End(xlUp).Row).Sort key1:=Range(Chr(64 + iCol) & 2), order1:=IIf(iIdx = 1, xlAscending, xlDescending), Header:=xlYes, Orientation:=xlTopToBottom
'
End Sub

Les n° de compteur en [A:A] ne sont pas triés.

- 'REC' qui sera la feuille de recherche et manipulations (ajout, modification et suppression) avec deux boutons "V" et "X".

* Toujours la même TextBox qui recherchera toute donnée contenant le texte tapé donc, par exemple, pour une recherche 123, la macro te donnera aussi bien 123456 que 987123.

Peut être pratique quand la mémoire flanche...

* Pour modification ou suppression, cliquer sur le contact désiré qui s'affiche en ligne 2.

La recherche s'efface en même temps mais, en y réfléchissant, ce serait sans doute mieux si elle restait pour une manipulation en série sur le même type de donnée... A toi de me dire...

Le bouton "X" s'active et le n° de contact s'allume en rouge, signe d'une possible suppression.

* Si, dans la foulée de cette sélection, tu modifies une donnée (en ligne 2, hein, tu suis?), le bouton "V" s'active à son tour.

A toi de choisir : bouton "V" pour modifier, "X" pour supprimer de 'BDD'.

* rendre le focus à la TextBox nettoie la feuille pour une nouvelle recherche.

* Pour créer un nouveau contact, tu auras compris qu'il ne faut pas avoir affiché une recherche en ligne 2 !!

La ligne 2 vierge, le moindre changement provoquera l'activation du bouton "V" alors que le n° de compteur en [A2], calculé automatiquement s'allumera de vert.

A tester et améliorable encore...

A+

34apt-annuaire.xlsm (53.58 Ko)

Bonsoir curulis57,

C'est vraiment de la créativité toutes ces idées

La recherche s'efface en même temps mais, en y réfléchissant, ce serait sans doute mieux si elle restait pour une manipulation en série sur le même type de donnée... A toi de me dire...

Je crois que c'est une bonne idée

Je vais testé ces différentes manipulations

Bonjour à tous

J'avais bien avancé avec un formulaire, mais quand j'ai vu la proposition de curulis qui est géniale et simple, ma solution me parait dépassée en ergonomie.

je peux finir si tu le souhaites mais ça ne sera pas mieux.

Cordialement

FINDRH

Bonsoir FINDRH,

La solution de curulis57 est bien simple, mais je songeais à adapter ta solution pour d’éventuel cas de gestion de BDD

Ok je termine le formulaire par la création d'une ligne

Cordialement

FINDRH

Salut apt,

Salut FINDRH,

Qu'est-ce donc ?

pour d’éventuel cas de gestion de BDD

Je peux jouer avec vous?

A+

Bonjour curulis57,

Je ne sais pas si on joue mais je pense que Apt veut voir une autre version avec un formulaire

Si ça peut l'aider je suis en train de finaliser une version nettement moins synthétique en termes de procédure macro

Je devrai finir ce matin donc tu pourras jouer avec, et l'améliorer je n'en doute pas !

Bonne journée

Cordialement

FINDRH

Bonjour à tous

Ci joint une proposition avec un formulaire multipages qui semble fonctionner chez moi...

Soumis a votre sagacité,

Par contre je refuse toute critique sur les couleurs utilisées, mais suis preneur de toute modification colorimétrique plus agréable à l’œil !!!

Bonne journée

FINDRH

Bonjour à tous,

curulis57 > j'ai plusieurs fiches technique, et je songe les mettre dans une base de données et ajouter un formulaire pour leurs traitement.

Apres, tu peux toujours nous apporté quelques idées, si FINDRH le permet

FINDRH > En premier, un grand merci pour le fichier joint, et surtout pour l'idée d'un USF multipages.

Apres essai, j'ai remarqué que les recherches par numéros de fixe ou de mobile ne sont pas sur toutes les colonnes correspondantes.

La recherche du fixe se fait seulement sur la colonne 6 (F) et pour le mobile, elle est faite sur la colonne 9 (I).

Rechercher des sujets similaires à "gestion annuaire telephonique"