كود يحولني الى واتس اب ويب بنفس الرقم بمجرد ان اختار رقم من التقرير واكبس عليه

[عبد اللطيف سلوم]

السلام عليكم 

احبتي الغوالي

برنامج بسيط جدا

الفكرة كالتالي

اقوم بتسجيل اسماء العملاء وارقام الواتس اب والايميل

بحيث عندما افتح التقرير اختار عميل

وبجرد ان اكبس على رقم هاتفه 

يحولني البرنامج تلقائيا الى واتس اب ويب على جهازي الكمبيوتر 

ويفتح لي دردشة مع نفس الرقم الذي اخترته

والايميل نفس الفكرة

بمجرد ان اكبس على الايميل ينقلني الى جي ميل واراسل البريد الذي اخترته

 

جزاكم الله خيرا

 

 

مرفق قاعدة البيانات للتطبيق عليها 

CONTACT 2025.accdb

[Foksh]

وعليكم السلام ورحمة الله وبركاته ,,

فيما يخص الإيميل ، فهذه فكرة بسيطة من خلال النقر على مربع نص الإيميل على سبيل المثال :-

Private Sub EMAIL_Click()
    Dim EmailAdd As String
    Dim GmailURL As String
    
    EmailAdd = Me.EMAIL.Value
    
    If Not IsValidEmails(EmailAdd) Then
        MsgBox "عنوان البريد الإلكتروني غير صالح", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    GmailURL = "https://mail.google.com/mail/?view=cm&fs=1&to=" & EmailAdd
    Application.FollowHyperlink GmailURL
End Sub

Function IsValidEmails(EMAIL As String) As Boolean
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "^[\w-\.]+@([\w-]+\.)+[\w-]{2,4}$"
    regex.IgnoreCase = True
    IsValidEmails = regex.Test(EMAIL)
End Function

 

والطلب الثاني ، وهو فتح واتس أب ويب على دردشة محددة للرقم الذي تم النقر عليه ، حذح محاولتي البسيطة ( مشتقة من أحد ملفاتي سابقاً ) ..

Private Sub MOB_Click()
    Dim WhatsURL As String
    Dim PhoneNum As String
    
    PhoneNum = Me.MOB.Value
    PhoneNum = CleanPhoneNum(PhoneNum)
    
    If PhoneNum = "" Then
        MsgBox "رقم الهاتف غير صالح", vbExclamation + vbMsgBoxRight, ""
        Exit Sub
    End If
    WhatsURL = "https://wa.me/" & PhoneNum
    Application.FollowHyperlink WhatsURL
End Sub

Function CleanPhoneNum(phone As String) As String
    Dim i As Integer
    Dim result As String
    
    result = ""
    For i = 1 To Len(phone)
        If IsNumeric(Mid(phone, i, 1)) Then
            result = result & Mid(phone, i, 1)
        End If
    Next i
    
    If Left(result, 2) = "00" Then
        result = Right(result, Len(result) - 2)
    ElseIf Left(phone, 1) = "+" Then
        result = Right(result, Len(result) - 1)
    End If
    CleanPhoneNum = result
End Function