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

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

السلام عليكم 

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

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

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

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

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

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

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

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

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

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

 

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

 

 

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

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

 

 

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

10 ساعات مضت, Foksh said:

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

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

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

 

 

اخوي الكريم @Foksh

الاكواد شغالة تمام -- لكن كود الواتس اب لما يفتح التطبيق لا يفتح حسب الرقم الذي تم اختياره 

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

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

[68SALLOUM]

On 7/8/2025 at 10:02 AM, Foksh said:

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

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

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

 

 

اخي فؤاد المحترم

تم تجربة الكود وهو شغال تمام

لكن هناك ملاحظة اتمنى تأخذها بعين الاعبار 

بدل ظهور خطوتين حتى نصل للواتس اب ويب

يا رييت لو يدخل مباشرة على واتس اب ويب

 

[68SALLOUM]

هذا البرنامج مع الكود

يا ريت تجربه وتعدل على الكود للدخول مباشرة الى واتس اب ويب

@Foksh

CONTACT 2025 (1).accdb