اذهب الي المحتوي
أوفيسنا

دروب مبرمج

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

  • Posts

    204

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

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

  • Days Won

    4

 نوع المحتوي 

كل منشورات العضو دروب مبرمج

  1. دروب مبرمج
    تفضل هذه الفكرة فكرة قوائم.zip
  2. دروب مبرمج
    النموذج sub1 مرتبط بإستعلام جدولي لا يمكن التعديل على البيانات اثناء الاستعلام اقترح بأن تستخدم جمل الاضافة لإضافة البيانات للجداول المرتبطة sub2 و sub3 قم بتشغل اذونات التحرير مرفق النموذج بعد التعديل up_ChangeSubForm.mdb
  3. دروب مبرمج
    انشئ نموذج جديد وا ضف فيه مستعرض ويب و في حدث عند النقر على قائمة الملفات ضع الكود التالي Dim wb As Object Set wb = WebBrowser0.Object ' ضورة اضافة اسم عنصر التحكم لمستعرض الويب Dim filelocation As String filelocation = "C:\Users\File1.pdf" ' ضع هنا اسم عنصر التحكم الذي يحتوي على اسم الملف لعرضه wb.silent = True With wb .navigate2 "about:blank" Do Until .ReadyState = 4 DoEvents Loop .Document.Open .Document.write "<!doctype html><html><head><title>my title</title></head><body scroll=""auto"" style=""margin: 0px; padding: 0px;"">" & _ "<embed style='padding: 70px;' src=""" & filelocation & """ width=""50%"" height=""100%"" />" & _ "</body></html>" .Document.close End With
  4. دروب مبرمج
    تفضل هذه المحاولة مع معلمي القديم @عمر ضاحى 1.accdb
  5. دروب مبرمج
    وتفضل هذه مشاركة مع الاخوان DD409.accdb
  6. دروب مبرمج
    لإرسال رسالة واتس اب اولاً / يجب تثبيت الواتس اب على الكبيوتر الخاص بك ثانياً / هذه هي الشفرة الأساسية للإرسال whatsapp://send?phone=" & "" & "&text=" & "" ثالثاً انشئ موديول جديد و الصق فيه الشفرة التالية Public Function SendMsg(Phon_Number As Variant, TexTMag As String) Dim StrURL As Variant Dim StrToNumber As Variant Dim StrMsg As Variant StrToNumber = Phon_Number StrMsg = EncodeQP2(TexTMag) StrURL = "whatsapp://send?phone=" & StrToNumber & "&text=" & StrMsg CreateObject("WScript.Shell").Run StrURL, 1, False Call StartTimer(3) Call SendKeys("{ENTER}") End Function Public Function EncodeQP2(s As String) As String Dim i As Long Dim p1 As Long Dim p2 As Long Dim r As String Dim n As Long For i = 1 To Len(s) n = AscW(Mid(s, i, 1)) If n < 128 Then r = r & "%" & Hex(n) ElseIf n < 2048 Then p1 = n \ 64 r = r & "%" & Hex(p1 + 192) p2 = n Mod 64 r = r & "%" & Hex(p2 + 128) Else End If Next i EncodeQP2 = r End Function Public Function StartTimer(NumberOfSeconds As Variant) On Error Resume Next Dim PauseTime, Start, Finish, TotalTime PauseTime = NumberOfSeconds Start = Timer Do While Timer < Start + PauseTime DoEvents Loop Finish = Timer TotalTime = Finish - Start End Function ثم في النموذج الخاص بك و في ازرار الارسال Call SendMsg("966590000000", "السلام عليكم")
  7. دروب مبرمج
    استخدم دالة التجميع الشرطية DCount مثال على ذلك DCount("*","Table_Name","[ID]=" & [Forms]![Forms_Name]![TextBox1]) هنا نكون قد طلبنا من الدالة عدد السجلات التي تحمل نفس الرقم في مربع النص TextBox1 و يمكن بهذا الطريقة اضافة شرط كما يلي If DCount("*", "Table_Name", "[ID]=" & [Forms]![Forms_Name]![TextBox1]) <> 0 Then If MsgBox("تم تسجيل الصنف من قبل" & _ vbNewLine & "هل تريد اضافة الصنف مرة أخرى؟" _ , vbQuestion + vbMsgBoxRight + vbYesNo, "تنبيه") = vbYes Then DoCmd.RunCommand acCmdSave MsgBox "تم اضافة صنف مشابه بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" Else DoCmd.RunCommand acCmdUndo MsgBox "تم التراجع عن الحفظ", vbCritical + vbMsgBoxRight, "تأكيد" End If Else MsgBox "تم تسجيل الصنف بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" End If يجب عليك الغاء المفاتيح الاساسية لكي تستطيع تنفيذ الشروط اعلاه
  8. دروب مبرمج
    يكون المعيار بهذا الشكل WHERE Year([datein] Between Year(Now()) And Year(Now())-3 النتيجة New Microsoft Access Database 1.accdb
  9. دروب مبرمج
    ما تحتاج كود لأن الكود يقوم بإنشاء نسخة مماثلة من النسخة الاساسية يعني ما راح يفتح الملف و يقرأ الجداول
  10. دروب مبرمج
    تفضل هذا هو كود النسخة الاحتياطية بإختصار لإنشاء نسخة احتياطة من القاعدة الحالية Dim MyFile As String Dim DstFile As String Dim Syso As Object Dim GetType As Variant MyFile = CurrentProject.FullName ' مسار القاعدة الحالية GetType = Right$(MyFile, Len(MyFile) - InStrRev(MyFile, ".")) DstFile = CurrentProject.Path & "\" & Format(Now, "dd-mm-yyyy-nss") & "." & GetType ' الاسم الجديد للنسخة الاحتياطية DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Name DstFile As DstFile & ".ptc" DBEngine.CompactDatabase DstFile & ".ptc", DstFile Kill DstFile & ".ptc" لإنشاء نسخة احتياطية لقاعدة البيانات في حال ان القاعدة منفصلة عن الواجهة Dim MyFile As String Dim DstFile As String Dim Syso As Object Dim GetType As Variant MyFile = CurrentProject.FullName ' مسار قاعدة البيانات GetType = Right$(MyFile, Len(MyFile) - InStrRev(MyFile, ".")) DstFile = CurrentProject.Path & "\" & Format(Now, "dd-mm-yyyy-hnss") & "." & GetType ' الاسم الجديد للنسخة الاحتياطية Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing
  11. دروب مبرمج
    ضع هذا الكود في ازرار التقرير If Not IsNull(TxtFrom) And IsNull(TxtTo) Then DoCmd.OpenReport "HR Data", acViewReport, _ , "EmployeeHiring = #" & TxtFrom & "#" ElseIf Not IsNull(TxtFrom) And Not IsNull(TxtTo) Then DoCmd.OpenReport "HR Data", acViewReport, _ , "EmployeeHiring Between #" & TxtFrom & "# And #" & TxtTo & "#" ElseIf IsNull(TxtFrom) And IsNull(TxtTo) Then DoCmd.OpenReport "HR Data", acViewReport End If تفضل التعديل Test (1).accdb
  12. دروب مبرمج
    هل هذا ما تريده ؟؟ AAA.accdb
  13. دروب مبرمج
    خير الكلام ما قل و دل ابدعت ابدعت و انرت الطريق للجميع بسطور معدودة سهلة الفهم و بكفرة ابداعية خارجة عن المألوف
  14. دروب مبرمج
    ماهي رسالة الخطأ التي تظهر لديك
  15. دروب مبرمج
    مع استعمال المكتبة انشى موديول جديد و الصق فيه الكود التالي Option Compare Database Option Explicit Const WIA_FORMAT_JPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}" Public Function MyScan() Dim ComDialog As WIA.CommonDialog Dim DevMgr As WIA.DeviceManager Dim DevInfo As WIA.DeviceInfo Dim dev As WIA.Device Dim img As WIA.ImageFile Dim i As Integer Dim wiaScanner As WIA.Device Set ComDialog = New WIA.CommonDialog Set wiaScanner = ComDialog.ShowSelectDevice(WiaDeviceType.UnspecifiedDeviceType, False, True) Set DevMgr = New WIA.DeviceManager For i = 1 To DevMgr.DeviceInfos().Count If DevMgr.DeviceInfos(i).DeviceID = wiaScanner.DeviceID Then Set DevInfo = DevMgr.DeviceInfos(i) End If Next i Set dev = DevInfo.Connect Set img = dev.Items(1).Transfer(WIA_FORMAT_JPEG) img.SaveFile CurrentProject.Path & "\img.jpg" Set img = Nothing Set dev = Nothing Set DevInfo = Nothing Set DevMgr = Nothing Set ComDialog = Nothing End Function
  16. دروب مبرمج
    تفضل التعديل Database3.accdb
  17. دروب مبرمج
    تفضل هذا المثال جربه عندك و اذا ضبط يصير نكمل الباقي Scanner.accdb
  18. دروب مبرمج
    ضبط سؤال جديد و ابشر بعزك طلبك بسيط
  19. دروب مبرمج
    تفضل هذا التعديل Database521 (1).accdb
  20. دروب مبرمج
    تفضل التعديل بحث.mdb
  21. دروب مبرمج
    تفضل faozi.accdb
  22. دروب مبرمج
    المشكلة كانت في العلاقات لم يكن هنالك علاقة بين الجداول كل ما عملته هو انشاء علاقة و انشاء فلتر من خلال الكود Sub NewSearsh() Dim varFilter As Variant varFilter = Null If Not IsNull(KindBook) Then: varFilter = (varFilter) & "[KindBook] LIKE '*" & KindBook & "*'" If Not IsNull(Rbtbook) Then: varFilter = (varFilter + " AND ") & "[Rbtbook] LIKE '*" & Rbtbook & "*'" If Not IsNull(EntryInfo) Then: varFilter = (varFilter + " AND ") & "[EntryInfo] LIKE '*" & EntryInfo & "*'" If Not IsNull(NObook) Then: varFilter = (varFilter + " AND ") & "[NObook] = " & NObook If Not IsNull(DateBook) Then: varFilter = (varFilter + " AND ") & "[DateBook] LIKE '*" & DateBook & "*'" If Not IsNull(Adbook) Then: varFilter = (varFilter + " AND ") & "[Adbook] LIKE '*" & Adbook & "*'" If Not IsNull(SavePlace) Then: varFilter = (varFilter + " AND ") & "[SavePlace] LIKE '*" & SavePlace & "*'" If Not IsNull(EtC) Then: varFilter = (varFilter + " AND ") & "[EtC] LIKE '*" & EtC & "*'" If Not IsNull([NoW]) Then: varFilter = (varFilter + " AND ") & "[NoW] LIKE '*" & [NoW] & "*'" If Not IsNull(DateW) Then: varFilter = (varFilter + " AND ") & "[DateW] LIKE '*" & DateW & "*'" If Not IsNull(AljegehaW) Then: varFilter = (varFilter + " AND ") & "[AljegehaW] LIKE '*" & AljegehaW & "*'" SubSur = varFilter End Sub و اخذنا نسخة من الاستعلام لوضعها ضمن الكود و دمج الفلتر معها
  23. دروب مبرمج
    RecordSource يعني اعادة تعيين مصدر البيانات مصدر البيانات الجديد ضمن الكود مع معايير البحث
  24. دروب مبرمج
    اذا هذا هو الحل تغيير العلاقات بحث.mdb
  25. دروب مبرمج
    سؤالك مختص بالمجال المحاسبي صمم الطريقة الي تحتاج يكون عليها الكشف و ابشر بعزك و كذلك حدد الأعمدة الي راح تكون مصدر البيانات
×
×
  • اضف...

Important Information

  I accept