XL 2013 Saisie sécurisée numéros de téléphone et ajout fonction clic droit de la souris

Helios77 · Mardi à 19:49

Bonjour à Tous,
Et dire que durant ma vie active j'ai fait pas mal de développements VBA sous excel... mais depuis que je suis à la retraite, je n'ai plus eu l'occasion jusqu'à maintenant de manipuler cet outil... Résultat.. je suis rouillé et j'ai besoin d'aide pour les 2 points suivants :
1 - j'ai une colonne "numéros de téléphone" dans un tableau, dont j'ai imposé le format d'affichage spécial "numéro de téléphone". Jusque là tout va bien.. Mais je n'arrive pas à imposer un format de saisie (10 chiffres) pour être certain de ne pas faire d'erreur lors de la saisie... Je connais bien la fonction "validation des données", mais incapable de trouver la bonne formule qui garantit ce format.
2 - je souhaite pouvoir lancer directement l'appel du numéro de téléphone contenu dans une cellules (d'où mon besoin d'être certain qu'elle est au bon format), en ajoutant la fonction "appeler" au menu contextuel du clic droit de la souris.
J'ai bien trouvé la manière de la faire en ajoutant une colonne à côté =SI(ESTVIDE([@[Tél Portable]]);"";LIEN_HYPERTEXTE("tel:+33"&F28;"☎")) mais mon tableau comporte déjà beaucoup de colonnes et j'aimerais donc le simplifier en intégrant cette possibilité directement avec le clic droit de la souris.
Je vous remercie d'avance de votre aide.
Amicalement
Helios

JM27 · Mardi à 20:57

bonsoir
Pour le point 1

Helios77 · Mardi à 21:02

Non car dans ce cas, rien n'empêche de taper des caractères alphabétiques ! OR.. il ne me faut que des chiffres

patricktoulon · Mardi à 21:10

Bonsoir
c'est simple tu fait la même chose en vba mais tu passe par followhyperlink
met ça dans le module thisworkbook
à l'ouverture tu aura le bouton "Appeler ce numero" dans le menu contextuel des cellules
à la fermeture le menu des cell sera réinitialisé
si la cellule cliqué n'est pas un numero a 10 chiffre "xxxxxxxxxx"tu a un message qui te le dit
bien sur on applique le numberformat telephone dans les cellules

VB:

'patricktoulon [click droit telephone]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    resetMenu
End Sub

Private Sub Workbook_Open()
    adTelmenu
End Sub
Sub resetMenu()
    Application.CommandBars("cell").Reset
End Sub
Sub adTelmenu()
    With Application.CommandBars("Cell")
        .Reset
        With .Controls.Add(msoControlButton, before:=1)
            .Caption = "Appeler ce numero"
            .FaceId = 598'choisi un icon comme tu veux la liste se trouve assez facilement sur le net
            .OnAction = "'" & ThisWorkbook.Name & "'!ThisWorkbook.allo"
        End With
    End With
End Sub

Public Sub allo()
    If IsNumeric(ActiveCell.Value) And Len("0" & ActiveCell.Value) = 10 Then
        ThisWorkbook.FollowHyperlink Format(ActiveCell.Value, """Tel:""00 00 00 00 00"), Format(ActiveCell.Value, """Tel:""00 00 00 00 00")
    Else
        MsgBox "ce n'est pas un numero valide"
    End If
End Sub

tout simplement
patrick

mapomme · Mardi à 23:28

Bonjour @Helios77 , @JM27, @patricktoulon, à tous,

Un essai via une validation de cellules.
J'ai considéré qu'il s'agissait de numéros de téléphone français de la forme 0 suivi de neuf chiffres significatifs.

La Plage dans le fichier joint est : F3:F13.
La formule de validation est :

=OU(F3="";SIERREUR(ET(ESTNUM(F3);NBCAR(F3)=9;ABS(F3)=F3);FAUX))

...

patricktoulon · Mercredi à 00:09

perso on attend un numero a 10 chiffres le 0 compris
donc la limite est 099 999 999
pas besoins de formule si je ne me trompe pas

mapomme · Mercredi à 00:24

Re @patricktoulon ,

C'est bête comme je me laisse influencé par le contenu de la question. Il y a le mot "formule" et aussitôt je me lance dans la recherche d'une formule plutôt que de reprendre le problème à la base.
Pour les numéros de téléphone français (0x xx xx xx xx), la validation suivante suffit qu'on saisisse ou non le zéro en première position :

patricktoulon · Mercredi à 07:07

re
Bonjour @mapomme
ben oui tout simplement
c'est encore mieux avec un min et un max ,ça forcera le nombre de caractère
bon ben maintenant il a tout
je redonne le click droit

VB:

'patricktoulon [click droit telephone]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    resetMenu
End Sub

Private Sub Workbook_Open()
    adTelmenu
End Sub
Sub resetMenu()
    Application.CommandBars("cell").Reset
End Sub
Sub adTelmenu()
    With Application.CommandBars("Cell")
        .Reset
        With .Controls.Add(msoControlButton, before:=1)
            .Caption = "Appeler ce numero"
            .FaceId = 598 'choisi un icon comme tu veux la liste se trouve assez facilement sur le net
            .OnAction = "'" & ThisWorkbook.Name & "'!ThisWorkbook.allo"
        End With
    End With
End Sub

Public Sub allo()
    If IsNumeric(ActiveCell.Value) And Len("0" & ActiveCell.Value) = 10 Then
        ThisWorkbook.FollowHyperlink Format(ActiveCell.Value, """Tel:""00 00 00 00 00"), Format(ActiveCell.Value, """Tel:""00 00 00 00 00")
    Else
        MsgBox "ce n'est pas un numero valide"
    End If
End Sub

Helios77 · Mercredi à 09:20

Bonjour à vous,
Encore merci de votre aide. J'avance mais malheureusement ce n'est pas encore ça.
Concernant le validation des données : Effectivement la solution la plus simple (moi aussi je m'étais noyé dans une "formule" ) est bien celle de ma pomme.. ! .
En revanche Patrick : pour la fonction "appel" : J'ai bien suivi ta procédure en copiant ton code dans le module ThisWorkbook, et ça fonctionne bien mais uniquement sur les Cellules extérieures à mon tableau . Or, bien évidemment, non seulement je souhaite que ça fonctionne pour les cellules de la colonne 'numéros de téléphone" qui contiennent ces numéros et UNIQUEMENT pour celles-ci qui, je le rappelle, ont un format spécial "numéro de téléphone".
Bizarre non ?
Amicalement
Helios

patricktoulon · Mercredi à 09:45

Bonjour Helios77
et alors ? tu sais pas faire?

VB:

'patricktoulon [click droit telephone]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    resetMenu
End Sub

Private Sub Workbook_Open()
    adTelmenu
End Sub
Sub resetMenu()
    Application.CommandBars("cell").Reset
End Sub
Sub adTelmenu()
    With Application.CommandBars("Cell")
        .Reset
        With .Controls.Add(msoControlButton, before:=1)
            .Caption = "Appeler ce numero"
            .FaceId = 598 'choisi un icon comme tu veux la liste se trouve assez facilement sur le net
            .OnAction = "'" & ThisWorkbook.Name & "'!ThisWorkbook.allo"
        End With
    End With
End Sub

Public Sub allo()
    'si on est pas dans la bonne feuille on sort
    If ActiveSheet.Name <> "Feuil1" Then Exit Sub 'adapter le nom de la feuille

    'ça peut être une colonne entière                   exemple :range("A:A")
    'ca peutetre une plage limité                       exemple : range("A1:A20")
    'ca peut être la colonne d'un tableau structuré     exemple  range("Tableau1[Téléphone]")

    'si la plage n'est pas celle des numéro on sort(Adapter la plage )
    If Intersect(Range("A:A"), ActiveCell) Is Nothing Then Exit Sub

    If IsNumeric(ActiveCell.Value) And Len("0" & ActiveCell.Value) = 10 Then
        ThisWorkbook.FollowHyperlink Format(ActiveCell.Value, """Tel:""00 00 00 00 00"), Format(ActiveCell.Value, """Tel:""00 00 00 00 00")
    Else
        MsgBox "ce n'est pas un numero valide"
    End If
End Sub

mapomme · Mercredi à 09:45

Bonjour @Helios77 , @patricktoulon,

Ce que tu as soulevé, je n'y avais jamais été confronté !

Il y a donc un menu contextuel pour la feuille et un autre menu contextuel spécifique aux tableaux structurés (TS) !

Après une rapide recherche, il faut utiliser pour le menu contextuel des TS le menu :
Application.CommandBars("List Range Popup")

C'est donc peu de chose à changer dans le code de @patricktoulon :

VB:

'patricktoulon [click droit telephone]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    resetMenu
End Sub

Private Sub Workbook_Open()
   adTelmenu
End Sub

Sub resetMenu()
   Application.CommandBars("List Range Popup").Reset
End Sub

Sub adTelmenu()
    With Application.CommandBars("List Range Popup")
        .Reset
        With .Controls.Add(msoControlButton, before:=1)
            .Caption = "Appeler ce numero"
            .FaceId = 598 'choisi un icon comme tu veux la liste se trouve assez facilement sur le net
            .OnAction = "'" & ThisWorkbook.Name & "'!ThisWorkbook.allo"
        End With
    End With
End Sub

Public Sub allo()
    If IsNumeric(ActiveCell.Value) And Len("0" & ActiveCell.Value) = 10 Then
        ThisWorkbook.FollowHyperlink Format(ActiveCell.Value, """Tel:""00 00 00 00 00"), Format(ActiveCell.Value, """Tel:""00 00 00 00 00")
    Else
        MsgBox "ce n'est pas un numero valide"
    End If
End Sub

patricktoulon · Mercredi à 10:01

je corrige
il faut l'ajouter aussi dans me menu des listobjects(tableaux structués)
on se croise @mapomme

VB:

'patricktoulon [click droit telephone]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    resetMenu
End Sub

Private Sub Workbook_Open()
    adTelmenu
End Sub
Sub resetMenu()
    bars = Array(Application.CommandBars("List Range Popup"), Application.CommandBars("Cell"))
    For b = 0 To UBound(bars)
        bars(b).Reset
    Next
End Sub
Sub adTelmenu()
    bars = Array(Application.CommandBars("List Range Popup"), Application.CommandBars("Cell"))
    For b = 0 To UBound(bars)
        With bars(b)
            .Reset
            With .Controls.Add(msoControlButton, before:=1)
                .Caption = "Appeler ce numero"
                .FaceId = 598 'choisi un icon comme tu veux la liste se trouve assez facilement sur le net
                .OnAction = "'" & ThisWorkbook.Name & "'!ThisWorkbook.allo"
            End With
        End With
    Next
End Sub

Public Sub allo()
    'si on est pas dans la bonne feuille on sort
    If ActiveSheet.Name <> "Feuil1" Then Exit Sub 'adapter le nom de la feuille

    'ça peut être une colonne entière                   exemple :range("A:A")
    'ca peutetre une plage limité                       exemple : range("A1:A20")
    'ca peut être la colonne d'un tableau structuré     exemple  range("Tableau1[Téléphone]")

    'si la plage n'est pas celle des numéro on sort(Adapter la plage )
    If Intersect(Range("Tableau1[Téléphone]"), ActiveCell) Is Nothing Then Exit Sub

    If IsNumeric(ActiveCell.Value) And Len("0" & ActiveCell.Value) = 10 Then
        ThisWorkbook.FollowHyperlink Format(ActiveCell.Value, """Tel:""00 00 00 00 00"), Format(ActiveCell.Value, """Tel:""00 00 00 00 00")
    Else
        MsgBox "ce n'est pas un numero valide"
    End If
End Sub

comme ça tu l'a dans les deux

patricktoulon · Mercredi à 10:21

et si tu veux quelque chose d'encore plus dynamique
je te montre comment ne pas avoir le bouton "Appeler ce numero" quand tu n'est pas sur la bonne plage

patricktoulon · Mercredi à 10:41

et comme je suis un peu dingue sur les borts et même à l'intérieur
exemple 3
le menu fonctionne dans une colonne de TS et ou dans une colonne de range
et cela sur la même feuille

toujours pareil ;si on est pas dans la bonne colonne le bouton est n'est pas là tout simplement
je peux aussi fournir le doliprane ou le nurofen si il faut

Maintenant tu a tout

Helios77 · Mercredi à 11:28

Merci .. tu es au top patrick.
Mais je vais encore abuser car dans mon tableau j'ai 2 colonnes de numéros de téléphone (Portable et Fixe)
J'ai donc voulu modifier ta macro de cette manière : if Not Intersect(Range("Tableau1[Tél Portable]":"Tableau1[Tél Fixe]"), ActiveCell) Is Nothing Then
Mais manifestement j'ai une erreur de syntaxe ou alors je n'ai pas tout compris à la fonction Intersect. -(
Merci

XL 2013 Saisie sécurisée numéros de téléphone et ajout fonction clic droit de la souris

Helios77

XLDnaute Nouveau

JM27

XLDnaute Barbatruc

Helios77

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Helios77

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Helios77

XLDnaute Nouveau

Discussions similaires