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

نجوم المشاركات

  1. د.كاف يار

    د.كاف يار

    الخبراء


    • نقاط

      11

    • Posts

      1,681


  2. أ / محمد صالح

    أ / محمد صالح

    أوفيسنا


    • نقاط

      10

    • Posts

      4,357


  3. jjafferr

    jjafferr

    أوفيسنا


    • نقاط

      5

    • Posts

      9,724


  4. Eng.Qassim

    Eng.Qassim

    الخبراء


    • نقاط

      3

    • Posts

      2,275


Popular Content

Showing content with the highest reputation on 23 يول, 2021 in all areas

  1. تفضل هذا الكود فقط انسخ و الصق في ازرار النسخة الاحتياطية On Error GoTo ErrH Dim fso As Object Dim fldrname As String Dim fldrpath As String Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\Backup" If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) DoCmd.RunSQL "CREATE TABLE Backup (Backup_NO INT , Backup_Name VARCHAR (50) , Backup_Path VARCHAR (100), Backup_Date Date);" End If Dim MyFile, DstFile, DataName As String Dim Syso As Object MyFile = CurrentProject.FullName DataName= "Backup-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ")" DstFile = CurrentProject.Path & "\Backup\" & DataName & ".accdb" 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 db As DAO.Database Dim MaxBackup_NO As Integer MaxBackup_NO = Nz(DMax("[Backup_NO]", "[Backup]"), 0) + 1 Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("Backup") With rs .AddNew ![Backup_NO] = MaxBackup_NO ![Backup_Name] = DataName ![Backup_Path] = DstFile ![Backup_Date] = Now() .Update End With rs.Close Set rs = Nothing MsgBox "تم انشاء قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تاكيد" Exit Sub ErrH: Select Case Err.Number End Select
    3 points
  2. هذا هو المطلوب كما تريد بالضبط طبقاً لشرحك تنسيق شرطى.xlsm
    2 points
  3. إذا كنت تقصد المعادلة في الخلية M18 فهذه تأتي بمعادلة البحث المستعملة في الشيت =VLOOKUP(D3,B26:L61,11,0) لأن خلية حالة العقد في الجدول بالأسفل تعتمد على خلية أخرى هي خلية سداد مبكر بتاريخ بالتوفيق
    2 points
  4. يمكنك استعمال هذه الدالة المعرفة Function checknum(rng As Range) For n = 1 To 100 If Sqr(rng * n + rng.Offset(0, 1)) = rng.Offset(0, 2) Then checknum = rng.Offset(0, 2): Exit Function End If Next n checknum = 0 End Function ولاستدعاء الدالة نضع في الخلية F2 =checknum(A2) ولا تنس حفظ الملف بصيغة تدعم الماكرو مثل xlsb بالتوفيق
    2 points
  5. وعليكم السلام 🙂 وبسبب انك ما اعطيتنا معلومات كافية ، فاختر المثال الاول او الثاني ، وكلاهما على حدث "النقر المزدوج" : الاول للنقر المزدوج للنموذج ، والثاني للحقل : جعفر
    2 points
  6. اجعل القيمة الافتراضية لرقم القيد =DLast("[رقم_القيد]";"السيارات")+1 عذرا استاذ عبد اللطيف ..ظننتك تريد اخر سجل وليس اكبر سجل
    2 points
  7. السلام عليكم اهل المنتدى الكرام أقدم اليكم برنامج : لجميع الانشطة ( تجارى – صناعى – خدمى – مقاولات ) مطابق تمام لمعايير المحاسبة الدولية كافة المعاملات ( حسابات ختامية – مراقبة مخازن – عملاء – موردين – شئون عاملين – استيراد – تصدير – مستخلصات – مراكز تكلفة – خطوط انتاج – مقايسات - باركود) يشمل البرنامج :- - حسابات الاستاذ كاملة وموازين المراجعة والارباح والخسائر والمركز المالى - تكاليف العمليات وتحليل تكاليف المشروعات وبنود الاعمال بشكل تفصيلى واجمالى - مستخلصات المشروعات - الايرادات - ومستخلصات مقاولين الباطن - منظومة الاجور والمرتبات بشكل متكامل ويمكن تعديلها حسب قانون الدولة - حسابات ضريبة المبيعات والارباح التجارية والصناعية وضريبة كسب العمل وطباعة الاقرارات الضريبية - مراقبة المخازن ومتابعة كروت الصنف وتسعير المنصرف بثلاثة طرق ( الوارد اولا يصرف اولا – المتوسط المرجح – اخر سعر ) - امكانية قرائة وطباعة الباركود وبدون الحاجة لطابعة خاصة - حسابات النقدية بالصندوق والبنوك وتعدد العملات - تكاليف الاستيراد وحساب تكلفة المشتريات المستوردة - حسابات تكاليف خطوط الانتاج وحساب تكلفة الوحدة من المنتجات - تعدد المستخدمين للبرنامج وصلاحيات خاصة لكل مستخدم وسهولة اضافة وحذف مستخدم وسهولة تعديل الصلاحيات - امكانية اضافة مجموعة شركات داخل البرنامج وكلمة مرور لكل شركة - يصلح البرنامج للعمل فى مصر وفى دول الخليج العربي - البرنامج يشمل روابط شرح تفصيلى لكل اجزائه واسم المستخدم وكلمة السر admin 123 وهذا هو البرنامج: بارك الله فيكم The_fastest.rar
    1 point
  8. ياليت تشرح كيف احتواء تلقائي هل تقصد مثل هذا اذا مثل هذا فهذه الطريقة و مرفق مثال لذلك بالعربي قابل للنوم = نعم / قابل للنقص = لا Report.mdb
    1 point
  9. يمكنك استعمال هذا الكود في حدث عند الضغط على الزر Private Sub CommandButton1_Click() Dim iRow As Long, Lastrow As Long, i As Long With ورقة1 Lastrow = .Cells(.Rows.Count, 7).End(xlUp).Row For r = 3 To Lastrow If .Cells(r, 7) = TextBox1.Value Then iRow = .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row .Cells(iRow, 3).Value = Me.TextBox1.Value .Cells(iRow, 4).Value = Me.TextBox2.Value MsgBox " لقد تم الترحيل بنجاح ", vbExclamation + vbMsgBoxRight, "تم الترحيل " GoTo 1 End If Next End With MsgBox "لايوجد هذا الاسمً ", vbInformation + vbMsgBoxRight, "تنبيه" 1: TextBox1.Value = "" TextBox2.Value = "" TextBox1.SetFocus End Sub بالتوفيق
    1 point
  10. بالنسبة لموضوع التنسيق الشرطي يمكنك كتابة نفس الشروط التي استعملتها على العمود L الذي تظهر فيه حالة العقد
    1 point
  11. لا أدري أين المشكلة عندك ولكن إذا كنت تريد تطبيق ذلك على ملف آخر بامتداد xlsb أولا تفتح شاشة الفيجوال بيسك داخل اكسل ثم تضيف موديول جديد وتلصق فيه الكود الذي يتحقق من رقم الماذربورد Function MBSerialNumber(Optional strComputer As String = ".") As String Dim v, vName, vUUID With GetObject("winmgmts:\\" & strComputer & "\root\cimv2") For Each v In .ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", , 48) vName = v.Name: vUUID = v.UUID Next v End With MBSerialNumber = vName & ", " & vUUID End Function ثم تضغط دبل كلك على thisworkbook وتلصق هذا الكود في حدث عند فتح الملف Private Sub Workbook_Open() Dim strMB1 As String, strMB2 As String, strMB3 As String 'Put Your MotherBoard Serial strMB1 = "HP ProDesk 490 G1 MT, FF004080-EE39-11E3-BFF8-A0D3C13F35B2" strMB2 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F" strMB3 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F" Select Case MBSerialNumber Case strMB1, strMB2, strMB3 Exit Sub Case Else MsgBox ("Data Security Failure. This Workbook Will Close") ActiveWorkbook.Close 1 End Select End Sub ثم تقوم بحفظ التغييرات وتغلق وتفتح الملف مرة أخرى بالتوفيق
    1 point
  12. كود جميل جدا ولكن أنا شخصيا لا أدخل أهتم بموضوع أو استفسار لا يرفق معه صاحبه مثالا على المطلوب مع توضيح المطلوب بمنتهى الدقة والتفاصيل والنتائج المتوقعة عيدكم مبارك
    1 point
  13. خلاص الحمدلله حصلت الإجابة على سؤالي شكرا لكم للإستفادة الدالة هي : Filter حيث انها تكون في اوفيس 365 واوفيس 2022 لاحقاً حسب علمي إن شاء الله. =FILTER(الزبائن!$E$5:$E$20000;الزبائن!$O$5:$O$20000=E3;"")
    1 point
  14. مرحبا اخي لا اعلم اين المشكلة ..لكن قد تكون لديك بيانات اضافية في ملفك الاساسي
    1 point
  15. تقدر تستعمل النموذج الذي اعطيتك هنا: جعفر
    1 point
  16. حسب فهمي للمطلوب جرب هذه المعادلة في الخلية L26 =IFERROR(IF(AND(M26<>"",M26<I26),"سداد مبكر",IF(TODAY()=I26,"العقد انتهى اليوم",IF(TODAY()>I26,"العقـد منتهى",IF(TODAY()<H26,"لم يتم تداولة","العقـد سارى")))),"") تم تعديل الشرط الأول إلى ألا تكون الخلية فارغة وتكون أقل من تاريخ نهاية العقد
    1 point
  17. بالاضافة الى ما تفضل به استاذنا الفاضل @د.كاف يار وله جزيل الشكر تفضل اخي الكريم جرب الكود التالي Dim strFolderPath As String Dim DB_Full_Name As String Dim DB_Name As String Dim Backup_Full_Name As String Dim Copy_File As Variant Dim DB_Directory As String strFolderPath = CurrentProject.Path & "\Backup\" ' التاكد من وجود مجلد Backup ' اذ لم يكن موجود يتم انشائه If Len(Dir(strFolderPath, vbDirectory)) = 0 Then MkDir strFolderPath End If ' تحديد قاعدة البيانات DB_Full_Name = CurrentProject.Path & "\" & CurrentProject.Name ' تحديد مسار قاعدة البيانات DB_Directory = CurrentProject.Path ' تحديد اسم قاعدة البيانات DB_Name = CurrentProject.Name ' تحديد مسار النسحة الاحتياطية Backup_Full_Name = strFolderPath & Left(DB_Name, Len(DB_Name) - 6) & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & ".accde" If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", vbQuestion + vbYesNo, "نسخة احتياطية") = vbYes Then Set Copy_File = CreateObject("Scripting.FileSystemObject") Copy_File.copyfile DB_Full_Name, Backup_Full_Name, True End If تحياتي
    1 point
  18. وعليكم السلام ورحمة الله وبركاته جرب الكود التالي =Nz(DMax("int([رقم_القيد])";"السيارات");0)+1 وهو يعمل اذا كان الحقل نص او رقم تحيايت
    1 point
  19. جرب الكود الي اعطيتك هو لا تحاول تنفذ اشياء تصعب عليك جرب الكود الي اعطيتك هو و بعد التجربة احكم هل يأدي المصلحة او لا
    1 point
  20. وأنا كل هالوقت اعتقد أنه زر وفي الأخير يطلع صندوق تسمية!!! شكرا يا @مسفر على كرم أخلاقك وردك على سؤالي. أخي أيو الحسن مشكلتك كانت من شقين أولهما أمر requery لا أعرف ترجمته الصحيحة ولكنه إعادة لتحميل البيانات والآخر هو استخدامك لصندوق التسمية فهو لا يستجيب عند النقر عليه باختيار السجل وقد عمل على صندوق النص وزر الأمر.
    1 point
  21. تفضل هذا المثال و هذا طباعة الباركود بنفس المقاسات المرفقة مع تعريف الطابعة موقع الشركة للحصول على التعريف اضغط هنا لتحميل التعريف الخاص بالطابعة مرفق الخط + المثال Desktop.zip
    1 point
  22. اشكركم توصلت الى الحل =DMax("[رقم_القيد]";"[السيارات]")+1
    1 point
  23. جاري محاولة تطويرة ...... هل طبق ماهو مكتوب في بداية الموضوع ؟؟؟؟؟ اخي الكريم موجودة كل الملفات في بداية الموضوع .... بشرط طبق ما في الشرح !!
    1 point
  24. اشرت انا سابقا ، الحل في هذه المشاركة : جعفر
    1 point
  25. جرب هذا الماكرو لا تنسى بانشاء مجلد backup في درايف c Sub savefile() Dim Path As String Dim Filename As String Path = "C:\backup\" Filename = Range("B3") ThisWorkbook.Sheets.Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=Path & Filename & ".xlsx", FileFormat:=51 Application.DisplayAlerts = True ActiveWorkbook.Close True End Sub
    1 point
  26. في مثل هذه الحالات يمكنك تسجيـل ماكرو وتفعل ما تريد وستحصل على الكود وتعدله كما تشاء
    1 point
  27. تفضل ::::: وهذ هو الكود الذي تحدث عنه أخي @ mohamedd2003 On Error Resume Next Langauge ELanguage.Ar Dim fOK As Boolean Dim strTemp As String Forms!whatsapp.SetFocus strTemp = Me.txtMessage fOK = SetClipboardData_clt(strTemp) '========================================================================================================= Langauge ELanguage.en Application.FollowHyperlink "https://wa.me/" & txtNumbers auseTime = 40 start = Timer Do While Timer < start + auseTime DoEvents Loop Call SendKeys("~", True) Call SendKeys("{Enter}", True) Call SendKeys("^v", True) Call SendKeys("{Enter}", True) '=========================================================================================================== MsgBox "تم الارسال للرقم المطلوب"
    1 point
  28. حيث انك لم ترفع ملف للمعاينة و من باب التكهن بما تريد اقترح لك هذا الملف degree.xlsm
    1 point
  29. اخي الكريم ابدء بإنشاء مشروعك على vb.net و ان استصعب عليك أمر ستجدنا في خدمتك فانشاء البرامج بالفيجوال بيسك ابسط بكثير من الأكسس و لن يستغرق معك وقت الأهم هو التخطيط الجيد و المنطقي ابدء بإنشاء مشروع جديد و قم بتصميم الواجهات التي ترغب بها و في مرحلة الكود سأقوم بمساعدك لكن خذي هذه النصيحة فقد تطورت الحياة و اصبح التعامل عن بعد هي من اهم الامور بها لذا فأنصح أن تبدء بإنشاء واجهاتك على vb.asp لكي يعمل مشورعك على الهواتف المحمولة مع مراعاة بأنه يتوجب عليك ان تضع الأمر في الماستر بيج <meta name = "viewport" content = "width=device-width; initial-scale=1.0; maximum-scale=1.0; user-scalable=0"/> لكي تتماشى الصفحات مع جميع احاجم الشاشات كالهواتف المحمولة مثلا
    1 point
  30. 1 point
  31. أعمار الديون.rar الاخ / احمد ابو العزم اليك الحل مع تغيير بعض الشئ فى شكل الجدول
    1 point
×
×
  • اضف...

Important Information