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

H

Helios77

XLDnaute Nouveau
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
 
Trier par date Trier par votes
J

JM27

XLDnaute Barbatruc
bonsoir
Pour le point 1

Capture.JPG
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
demo1.gif
 
Dernière édition:
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
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))
Cliquez pour agrandir...

1730240522225.png

...
 

Pièces jointes

  • Helios77- Validation TEL FR- v1.xlsx
    10.1 KB · Affichages: 3
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
H

Helios77

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
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
 

Pièces jointes

  • patricktoulon- mod mapomme- TS menu context. -v1.xlsm
    19.3 KB · Affichages: 1
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
 

Pièces jointes

  • exemple 1.xlsm
    16.3 KB · Affichages: 2
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
diabolo.gif

demo1.gif



Maintenant tu a tout ;)
 

Pièces jointes

  • exemple 3.xlsm
    18.4 KB · Affichages: 4
Vote positif 0 Vote négatif
H

Helios77

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif

Discussions similaires

Eric C
  • Résolu(e)
XL 2010 Propriété MaxLength d'une TextBox pour saisie n° de téléphone
2
Réponses
23
Affichages
2 K
Eric C
Eric C
S
  • Résolu(e)
Microsoft 365 Liste déroulante avec plusieurs colonnes de tableaux + Recherche valeurs en fonction de la valeurs selectionnée
Réponses
2
Affichages
290
Sosobob
S
A
  • Question
Microsoft 365 Slicer - supprimer le menu contextuel ou la possibilité de supprimer le filtre
Réponses
1
Affichages
563
xUpsilon
xUpsilon
J
  • Question
XL 2019 (Résolu) VBA - Mise en surbrillance de ligne (fonction dans ruban)
Réponses
3
Affichages
444
Julien_B
J
L
  • Question
empêcher le clic droit de la souris/l'affichage du menu contextuel dans Excel
Réponses
2
Affichages
707
Lorenzini
L
C
  • Question
Microsoft 365 formatage cellule n° de téléphone
Réponses
4
Affichages
714
Chapichapo
C
L
  • Résolu(e)
Microsoft 365 VBA double clic et saisie de cellule avec texte et horaire
Réponses
4
Affichages
481
Le novice
L
C
  • Question
XL 2021 Positionnement sur une cellule en fonction de la date, du jour et de l'heure
Réponses
2
Affichages
397
clausen
C
J
  • Question
XL 2016 bloquer la saisie d'une cellule et la griser en fonction de la valeur d'une autre cellule
Réponses
6
Affichages
836
JJ1958
J
Usine à gaz
  • Résolu(e)
Microsoft 365 Remplacer le 33 du numéro de téléphone (Petite dernière du WE )
2
Réponses
23
Affichages
3 K
Usine à gaz
Usine à gaz

Membres actuellement en ligne

24 membres et 375 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 698
Messages
2 111 998
Membres
111 386
dernier inscrit
ltitia.david