اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم 

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

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

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

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

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

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

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

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

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

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

 

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

2025-07-08_160709.png.f0303baca8060a919c2df11ebd4bf748.png

 

 

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

CONTACT 2025.accdb

قام بنشر

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

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

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

 

 

  • Like 3
قام بنشر
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

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

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

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

قام بنشر
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

 

 

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

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

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

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

001.png.3d57bbc844bc8c96350fac858754bf87.png

002.png.88ab9ed8eae393fa2ab3bf8782c4ef8c.png

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

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   1 عضو متواجد الان

×
×
  • اضف...

Important Information