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

د.كاف يار

الخبراء
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    1681

  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    60

 نوع المحتوي 

كل منشورات العضو د.كاف يار

  1. د.كاف يار
    طيب جرب هذا التعديل DATA14.zip
  2. د.كاف يار
    حددت نفس النطاق في ملف الاكسل المرفق لكن اعطيني نسخة من ملف الاكسل الي استخدمته
  3. د.كاف يار
    تفضل التعديل اخي الكريم و اغتذر عن التأخير لأن الموضوع اخذ وقت لأجل اضبط كود تشفير البيانات مجرد حيلة عشان يترسل النص مشفر و يرجع صحيح مع تغيير المحرر الى Msxml2.XMLHTTP.6.0 cang _lang_ar_en.accdb
  4. د.كاف يار
    تفضل هذه المشاركة يابو الحسن DATA14.zip
  5. د.كاف يار
    اخي الكريم تستطيع تصدير التقرير بصيغة PDF تستطيع ربط البريد الإلكتروني مع الأكسس *** هذه الإجراءات كلها تستطيع تنفيذها بأزرار واحد فقط *** مع ملاحظة بأنه يجب عليك تفعيل وصول التطبيقات الأقل أمانا في بريد Gmail On Error GoTo errorhandle '=============== انشاء مجلد لحفظ التصدير ====================== Dim fso As Object Dim fldrname, fldrpath, FolderName As String FolderName = "MyBill" Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\" & FolderName If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) End If '=============== تصدير التقرير ====================== Dim FilePath, ReportName, BillNumber As String BillNumber = "Bill - " & BillNumber ' هنا اسم القرير الجديد FilePath = CurrentProject.Path & "\" & FolderName & "\" & BillNumber & ".pdf" ReportName = "Report1" ' اسم التقرير المطلوب تصديره DoCmd.OutputTo acOutputReport, "Report1", "PDFFormat(*.pdf)", FilePath, False, "" '=============== ارسال التقرير بالإيميل ====================== Dim imsg As Object Dim iconf As Object Dim flds As Object Dim schema, settingsUsername, settingsPassword As String settingsUsername = "ادخل بريد الجيميل" settingsPassword = "كلمة المرر" Set imsg = CreateObject("CDO.Message") Set iconf = CreateObject("CDO.Configuration") Set flds = iconf.Fields schema = "http://schemas.microsoft.com/cdo/configuration/" flds.Item(schema & "smtpusessl") = True flds.Item(schema & "smtpauthenticate") = 1 flds.Item(schema & "sendusername") = settingsUsername flds.Item(schema & "sendpassword") = settingsPassword flds.Item(schema & "smtpserver") = "smtp.gmail.com" flds.Item(schema & "sendusing") = 2 flds.Item(schema & "smtpserverport") = 465 flds.Update Dim Mymsg, MsgToSend As String MsgToSend = "نص الرسالة" Mymsg = "<html><head><meta http-equiv='Content-Type' content='text/html;charset=UTF-8'><title></title></head><body style='direction: rtl; font-weight: 700; text-align: right; font-size: medium'> <p> " & "" & "<br />" & MsgToSend & "<br />" & "" & "</p></body></html>" With imsg .BodyPart.Charset = "UTF-8" .to = StudentEmaile .from = DLookup("settingsUsername", "settings", "settingNO=1") .Subject = BillNumber .HTMLBody = Mymsg .AddAttachment (MyAttachment) Set .Configuration = iconf .Send End With Set iconf = Nothing Set imsg = Nothing Set flds = Nothing errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description Resume errorhandleexit
  6. د.كاف يار
    ماشاء الله لا قوة الا بالله فناااان من طراز عريق
  7. د.كاف يار
    تعديل المسميات يكون داخل الاستعلام
  8. د.كاف يار
    اخي الكريم هذه مشاركة مع زملائي دعنا نتعلم كيف يتم استيراد ملف اكسل بأسهل الطرق أولا / نحتاج لفتح مربع تحرير لإختيار ملف الإكسل من الكمبوتر و حفظ مساره Dim Addfile As Object Dim filepath As String On Error GoTo errorhandle Set Addfile = Application.FileDialog(3) With Addfile ' فتح مربع التحرير لإختيار الملف .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "All Files", "*.*" If .Show = True Then ' هنا تم تحديد الملف من مربع التحرير filepath = Trim(.SelectedItems(1)) ' مسار الملف '=================================== '''''' استيراد الملف بعد التحديد'''''' '=================================== DoCmd.TransferSpreadsheet acImport, 10, "اسم الجدول", filepath, False, "" MsgBox "تم الاستيراد بنجاح", vbOKOnly + vbMsgBoxRight, "تأكيد" Else Exit Sub End If End With errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description Resume errorhandleexit
  9. د.كاف يار
    اتوقع انك تقصد مثل هذي الصورة الكود في الاستديو VB.NET Me.IsMdiContainer = True With [Form Name] .MdiParent = Me .Show() End With لا يوجد شيئ مستحيل في البرمجة و سأحاول ان اصل للطريقة في الاكسس و كذلك المكتبة المناسبة لهذه الفكرة
  10. د.كاف يار
    هذا شرح مبسط سويته على ملف بوربونت شرح.pptx
  11. د.كاف يار
    تم ذلك الرسم البياني.zip
  12. د.كاف يار
    لإجراء اتصال هاتفي انشئ موديل جديد و الصق به الكود التالي Option Explicit Declare PtrSafe Function tapiRequestMakeCall Lib "tapi32.dll" (ByVal stNumber As String, ByVal stDummy1 As String, ByVal stDummy2 As String, ByVal stDummy3 As String) As Long Public Const ID_CANCEL = 2 Public Const MB_OKCANCEL = 1 Public Const MB_ICONSTOP = 16, MB_ICONINFORMATION = 64 Function DialNumber(PhoneNumber) Dim Msg As String Dim MsgBoxType As Integer Dim MsgBoxTitle As String Dim RetVal As Long Msg = "Please pickup the phone and click OK to dial " _ & PhoneNumber MsgBoxType = MB_ICONINFORMATION + MB_OKCANCEL MsgBoxTitle = "Dial Number" If MsgBox(Msg, MsgBoxType, MsgBoxTitle) = ID_CANCEL Then Exit Function End If RetVal = tapiRequestMakeCall(PhoneNumber, "", "", "") If RetVal < 0 Then Msg = "Unable to dial number " & PhoneNumber GoTo Err_DialNumber End If Exit Function Err_DialNumber: Msg = Msg & vbCr & vbCr & _ "Make sure no other devices are using the Com port" MsgBoxType = MB_ICONSTOP MsgBoxTitle = "Dial Number Error" MsgBox Msg, MsgBoxType, MsgBoxTitle End Function و في ازرار الاتصال ضع التالي DialNumber ([رقم الهاتف]) و للأمانة الكود منقول و لم اجربه لعدم توفر هاتف ثابت لدي
  13. د.كاف يار
    خطأ في أمر تعطيل الاضافة استخدم الشفرة التالية With subtblIbriData .Form.AllowAdditions = False End With
  14. د.كاف يار
    تفضلي هذا و لتحرير تنسيق الرسم فقط اضغطي مزدوج على الرسم لعرض الخصائص الرسم البياني.accdb
  15. د.كاف يار
    استخدم هذا الموقع اضغط هنـــــــــــــــا
  16. د.كاف يار
    في الاكسس تقوم بإستخدام المعيار التالي like "*" & [forms]![top]![qq]& "*" أما مع استخدام SQL يتم استبداء علامة (*) بـ (%) like '%" & [forms]![top]![qq]& "%'
  17. د.كاف يار
    جرب هذا التعديل اضف الشفرة التالية في اي مكان داخل محرر الأكواد Private Function GTranslate(strInput As String, strInput2 As String, strInput3 As String) As String Dim strURL As String, objHTTP As Object, objHTML As Object, objDivs As Object, objDiv As Variant strURL = "https://translate.google.com/m?hl=" & strInput2 & _ "&sl=" & strInput2 & _ "&tl=" & strInput3 & _ "&ie=UTF-8&prev=_m&q=" & strInput ' سابقا 'Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") Set objHTTP = CreateObject("Msxml2.XMLHTTP.6.0") objHTTP.Open "GET", strURL, False objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko" objHTTP.Send "" Set objHTML = CreateObject("htmlfile") With objHTML .Open .Write objHTTP.responseText .Close End With Set objDivs = objHTML.getElementsByTagName("div") For Each objDiv In objDivs Debug.Print objDiv.innerText If objDiv.className = "result-container" Then GTranslate = objDiv.innerText: Exit For End If Next objDiv Set objHTML = Nothing: Set objHTTP = Nothing End Function ضع في حدث الأزرار عند النقر الكود التالي MsgBox GTranslate("كرة", "en", "ar") في حال استمرار المشكلة يرجى ضبط اعدادات اللغة الاقليمة لديك
  18. د.كاف يار
    اجعلها نعم كما في الصورة
  19. د.كاف يار
    تفضل التعديل اخي الكريم invoice11.zip
  20. د.كاف يار
    if [TextBox]>99 then MsgBox "الكمية تتجاوز الحد المسموح", vbCritical + vbMsgBoxRight, "تنبيه" DoCmd.RunCommand acCmdUndo End if تضعه في حدث بعد التحديث بعد التعديل عليه بما يتناسب الحقول لديك
  21. د.كاف يار
    اخوي صمم استعلام تجميع بحث يجمع كل الأصناف المتشابهة بإمكانك ترفق مثال عشان تكون الفكرة واضحة
  22. د.كاف يار
    تفضل هذا التعديل DATA200026.mdb.zip
  23. د.كاف يار
    اخي الكريم اقترح عليك الأتي - قسم قاعدة البيانات - ضع نسخة من البرنامج بعد فصله عن قاعدة البيانات و لا تقم بمشاركة النماذج - اتصل بقاعدة البيانات من خلال الكود و بكذه راح تلاحظ ان حتى الأداء صار اسرع و افضل و ما راح يكون فيه مجال للتعارض
  24. د.كاف يار
    تفضل التعديل IT_V2.zip
  25. د.كاف يار
    تفضل التعديل سيتم انشاء مجلد بإسم Files حفظpdf.zip
×
×
  • اضف...

Important Information

  I accept