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

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

  1. احمد بدره

    احمد بدره

    الخبراء


    • نقاط

      7

    • Posts

      979


  2. د.كاف يار

    د.كاف يار

    الخبراء


    • نقاط

      6

    • Posts

      1,681


  3. أبو إبراهيم الغامدي
  4. محمد أبوعبدالله

    • نقاط

      6

    • Posts

      1,998


Popular Content

Showing content with the highest reputation on 27 أغس, 2020 in all areas

  1. أهلا بالجميع... من الممكن تطبيق الفكرة بواسطة أكسس بواسطة عناصر ActiveX القياسية المتوفرة ضمن عناصر التحكم.. في المثال المرفق استخدمت Picturelip و Image (عناصر ActiveX) من أجل تحقيق المطلوب يقوم العنصر PictureClip بتقطيع الصور بناء على عدد الأعمدة والصفوف التي يحددها المستخدم... بعد ذلك نقوم بإسناد الصورة المقطوعة إلى العنصر Image من أجل العرض.. عند النقر على رقم الصورة المعروضة يتم حفظها منفردة.. أترككم مع المثال ونناقش فيما بعد الحفظ التلقائي.. MSAccess With PictureClip.zip
    4 points
  2. جرب هذا الكود Option Explicit Sub Get_aLL() Dim Rg_A As Range Dim Rg_D As Range, Rg_G As Range Dim a%, d%, g%, X% Dim St1$, St2$ Dim Dic As Object Range("k3").CurrentRegion.ClearContents Set Rg_A = Range("A3", Range("A2").End(4)) Set Rg_D = Range("D3", Range("D2").End(4)) Set Rg_G = Range("G3", Range("G2").End(4)) a = Rg_A.Rows.Count: d = Rg_D.Rows.Count g = Rg_A.Rows.Count St1 = "All Products": St2 = "All Volume" Set Dic = CreateObject("Scripting.dictionary") For X = 3 To a - 2 If Not Dic.exists(Cells(X, 1).Value) Then Dic(Cells(X, 1).Value) = Cells(X, 2) Else Dic(Cells(X, 1).Value) = Dic(Cells(X, 1).Value) + Cells(X, 2) End If Next '+++++++++++++++++++++++++ For X = 3 To d - 2 If Not Dic.exists(Cells(X, 1).Value) Then Dic(Cells(X, 4).Value) = Cells(X, 5) Else Dic(Cells(X, 4).Value) = Dic(Cells(X, 4).Value) + Cells(X, 5) End If Next '+++++++++++++++++++++++++ For X = 3 To g - 2 If Not Dic.exists(Cells(X, 7).Value) Then Dic(Cells(X, 7).Value) = Cells(X, 8) Else Dic(Cells(X, 7).Value) = Dic(Cells(X, 7).Value) + Cells(X, 8) End If Next '++++++++++++++++++++ Range("k3").Resize(Dic.Count) = _ Application.Transpose(Dic.keys) Range("L3").Resize(Dic.Count) = _ Application.Transpose(Dic.Items) Range("k2") = St1: Range("l2") = St2 Range("k2").CurrentRegion.Sort Key1:=Range("L2") _ , order1:=2, Header:=1 End Sub الملف مرفق Master.xlsm
    2 points
  3. تم وضع كود عند أي تغيير يحدث في tbxName يظهر رقم تسلسل للاسم الجديد وتم وضع ماكرو كود ترقيم سميت Tمن أعمال أستاذنا الفاضل سليم حاصبيا حتى إذا أردت حذف فيقوم بإعادة الترقيم العمودA بشرط لا تكون الخلية المجاورة B فارغة نموذج المطلوب-1.xlsm
    2 points
  4. أهلا بك @hamdy1111 هذا يعني أن مكتبة تقطيع الصور ليست على نظامك.. أرفقت مع المثال نسخة من المكتبة ضمن المثال المرفق. قم بإعادة تحميله؛ وأتبع الخطوات التالية .. إذا كان نظامك على معمارية 64bit: قم بنسخ المكتبة وضعها في المجلد (sysWOW64). .. إذا كان نظامك على معمارية 32bit: قم بنسخ المكتبة وضعها في المجلد (system32). .. أعد تشغيل ملف أكسس.
    2 points
  5. ممكن أن تكون المعادلة هكذا =IF(ورقة1!A1="";"";9+9) أو =IF(ورقة1!A1="","",9+9) أي أنه لو الخلية A1 في ورقة 1 فارغة لا يتم حساب شيء أما إذا كانت غير فارغة اجمع 9+9 تبع إعدادات جهازك الفاصلة أم الفاصلة المنقوطة
    2 points
  6. العفو اخي صالح انتم اكبر من ذلك ولكن كان الايضاح لحاجة في نفس يعقوب نعود للفكرة الرابط بين قاعدة البيانات في جهاز العميل والسيرفر الجداول ملف موجود على السيرفر ويتم الاشارة الى مكان وجودة في قاعدة بيانات العميل روابط اخرى تتعلق بالصلاحيات وطريقة تعريف الاجهزة والتحكم بها ولكن هنا نكون انتقلنا الى مسار اكثر احترافية وتعقيدا برامج خارجية للتحكم بالاجهزة وقد اشرت الى احدهم في مشاركتي الاولى لذا فاي مبرمج سوف يقترح احد هذه الحلول الحل الاسهل حقل في الجدول ثم كود عند عداد الوقت او امر محاكي لعداد الوقت وهو ما اشرت اليه في ردي كفكرة وسبقتوني اليه باكثر من عام الحل الثاني ملف موجود على السيرفر وتم التطرق اليه في رد الاخ @jjafferr في موضوع مختلف قليلا ولكن يمكن استخدامه مع اجراء بعض التعديل ليقوم بالاغلاق لجهاز العميل if Dir("D:\Test\AMIN.xls") ="" then msgbox "لم يتم الحصول على الملف المطلوب" exit sub 'اخرج من البرنامج endif الحل الثالث المح اليه الاستاذ @أ / محمد صالح باستفسار من صاحب الموضوع وهو متعلق بصلاحيات الادارة للاجهزة المرتبطة الحل الرابع وهو البرنامج الخارجي وتختلف المميزات باختلاف البرنامج فبعضها يعطي صلاحيات التحكم في التعديل والاغلاق وبعضها اضافة لذلك يمتاز بارسال رسائل فورية للمستخدمين قالت العرب "الافكار كالحجارة ملقاة في الطريق يعرفها العربي والعجمي وإنما الشأن في إقامة الوزن وتخير اللفظ وسهولة المخرج وجودة السبك فإنما الشعر صناعة وضرب من النسج وجنس من التصوير" وكذلك الامر في كل امر بما فيها البرمجة الفكرة موجودة والفن في جودة التنفيذ وهذا في صالحكم اخي الفاضل 🌹 تحياتي وتقديري
    2 points
  7. بارك الله فيك استاذ محمد ولإثراء الحل -يمكنك استخدام هذه الدالة المعرفة Function Ahmed_Date(myid As Variant, Optional stype As Byte = 1) As Variant If myid = "" Then Ahmed_Date = "": Exit Function Dim n As Byte, governrate As Variant If stype = 1 Then Ahmed_Date = DateSerial(IIf(Left(myid, 1) = 2, 19, 20) & Mid(myid, 2, 2), Mid(myid, 4, 2), Mid(myid, 6, 2)) ElseIf stype = 2 Then governrate = Array("01-ÇáÞÇåÑÉ", "02-ÇáÅÓßäÏÑíÉ", "03-ÈæÑÓÚíÏ", "04-ÇáÓæíÓ", "11-ÏãíÇØ", "12-ÇáÏÞåáíÉ", "13-ÇáÔÑÞíÉ" _ , "14-ÇáÞáíæÈíÉ", "15-ßÝÑ ÇáÔíÎ", "16-ÇáÛÑÈíÉ", "17-ÇáãäæÝíÉ", "18-ÇáÈÍíÑÉ", "31-ÇáÈÍÑ ÇáÃÍãÑ", "32-ÇáæÇÏì ÇáÌÏíÏ" _ , "19-ÇáÅÓãÇÚíáíÉ", "21-ÇáÌíÒÉ", "22-Èäí ÓæíÝ", "23-ÇáÝíæã", "24-ÇáãäíÇ", "25-ÃÓíæØ", "34-ÔãÇá ÓíäÇÁ", "35-ÌäæÈ ÓíäÇÁ" _ , "26-ÓæåÇÌ", "27-ÞäÇ", "28-ÃÓæÇä", "29-ÇáÃÞÕÑ", "33-ãØÑæÍ", "88-ÎÇÑÌ ãÕÑ") For n = 0 To 27 If Mid(myid, 8, 2) = Left(governrate(n), 2) Then Ahmed_Date = Right(governrate(n), Len(governrate(n)) - 3) Exit For End If Next Else Ahmed_Date = IIf(Mid(myid, 13, 1) Mod 2 = 0, "ÃäËì", "ÐßÑ") End If End Function وعليك بوضع هذه المعادلة فى عمود محل الميلاد بداية من الخلية M6 =Ahmed_Date(E6,2) تنسيق 2020 عام-1.xls
    2 points
  8. السلام عليكم 🙂 الموقع كان فيه عطل فني يوم الاثنين وصباح الثلاثاء ، والاستاذ محمد مدير الموقع كان متابع الموضوع 🙂 للعلم 🙂 جعفر
    1 point
  9. دالة datedif موجودة في جميع إصدارات إكسل ولكنها غير موجودة في قائمة الدوال ولا تظهر في الإكمال التلقائي نظرا لاختلاف عالمي في طريقة حساب الفرق بين تاريخين ويمكنك الاستفادة من هذا الرابط https://www.mr-mas.com/p/datedif.html لخساب الفرق بين تاريخين أونلاين وفي برنامج ميكروسوفت إكسيل
    1 point
  10. ومافي اي اشكال من يوم الثلاثاء والحمد لله 🙂 رجاء تخبرنا عن اسم المتصفح ورقم النسخة . جعفر
    1 point
  11. العفو أستاذ ابوطيبه (ابوفهد) العبارة : تم وضع كود عند أي تغيير يحدث في tbxName يظهر رقم تسلسل للاسم الجديد أي أنه عند إضافة اسم جديد فإنه سيتم ترقيم TextBox1 وبالتالي عند الترحيل سيتم الترقيم في العمود A
    1 point
  12. السلام عليكم 🙂 من تجربتي مع هذه الملفات ، للأسف الشديد ما ممكن عمل اصلاح لها ، وحتى اني رفعت احدها لأحد الشركات المتخصصة في استرجاع البيانات ، ولكن للأسف بدون فائدة !! نعم ، اذا كانت الجداول موجودة ، فهناك امل في استرداد البيانات بإستعمال برامج خارجية ، مثل هذه : جعفر
    1 point
  13. تفضل التعديل اخي الكريم 22.accdb
    1 point
  14. فكرة رائعة اخوي ابو ابراهيم 🙂 يعني لازم نبحث في برامج OCX ونشوف اللي ممكن تعمله 🙂 جعفر
    1 point
  15. شاكر ومقدر تعبك اخي لكني اذا اضفت القاعدة يطلعلي غير مسموح لك برفع ملف بهذا الحجم مسموح لك بهذه المساحه ١٬٠٠٣٫٥٢كيلو بايت
    1 point
  16. وعليكم السلام .. تم تحرير عمود الكمية Y وفك تقييده , كما تم دمج المعادلات طبقاً للمطلوب بهذه المعادلة بعمود القيمة =IFERROR(IF($U5="نقلة",$Z5,IF(AND(Y5>=SUMIF(data!$A$18:$A$21,$AA5,data!$B$18:$B$21),$U5="طن"),($Y5*$Z5),$Z5*SUMIF(data!$A$18:$A$21,$AA5,data!$B$18:$B$21))),"") 12346.xlsm
    1 point
  17. الله يحغظك يا عالي أنا أعلم ذلك و لو كنت مكانك لفعلت نفس الشيء لأن هذه هي صفاة أصحاب العلم بالنسبة للموضوع لقد طرحت 4 أفكار مختلفة و جيدة لكن يجب أن نضع في الحسبان جيدا أن أمر الصلاحيات و التحكم عن بعد فيها الكثير من الخطر لو وقعت في أياد غير أمينة
    1 point
  18. فكرة ممتازة أخي ابا ابراهيم ::::: تشكر
    1 point
  19. ماشاء الله عليك ابو ابراهيم اتابع بصمت ......
    1 point
  20. دالة DATEDIF موجودة في نسخ الإكسيل حتى عام 2000 أما بعد ذلك لم تعد موجودة ضمن الدوال ولكن إذا كتبت الدالة فإنها تعمل
    1 point
  21. وعليكم السلام-لا يوجد دالة اصلاً بهذا الإسم .... الدالة اسمها DATEDIF وليس Dateif
    1 point
  22. الله عليك استاذنا القدير / @kha9009lid شرح واضح ورائع باربع طرق وكما اشار استاذنا القدير القمة / @jjafferr المنتدى دسم بالمعلومات لكن الذى جعلنى ان اضع مشاركتى هنا وهو الحكمة التى ذكرها استاذنا / خالد ففيها معنى كبير للحياة والتطبيق على كل مراحل العلم منها طبعا البرمجة حلوة جدا جدا هذه الحكمة واذا سمح لى استاذنا خالد ان استعيرها فى بعض الامور لى جزاكم الله خيرا على هذا الحضور القوى والهام لنا كطلبة لديكم .
    1 point
  23. لم اسىء الظن بك اخي الكريم بارك الله فيك ولكني اقوم بالتنبيه فقط تحياتي
    1 point
  24. مختار هذا بالنسبة للنموذج ولكنك لم تضع معيار او فلتر للتقرير DoCmd.OpenReport "sc", acViewPreview, , "[jname] ='" & Me.jname & "'" test.rar تحياتي
    1 point
  25. اخي الكريم للربط مع قاعدة البيانات يجب اولا احضار عنوان السيرفر و كذلك كلمة المرور و اسم المستخدم لاضافة السورس الخاص بالاتصال X1= عنوان السيرفر X2= كلمة المرور X3= اسم المستخدم Data Source=X2;Persist Security Info=True;User ID=X2;Password=X3 الان اتبع الصور لانشاء اتصال و ربط بقاعدة البيانات الاخرى
    1 point
  26. جزاك الله كل خير على هذا الاسلوب الرائع فعلا لا تطعمني كل يوم سمكة ولكن علمني كيف اصيد اشكرك اخي محمد
    1 point
  27. تفضل هذا الكود اخي الكري مع مراعاة التغيير حسب المتغيرات الاسم و صيغة قاعدة البيانات كما يمكنك تثبيت موقع قاعدة البيانات من خلال تثبيت القيمة للمتغيير strBEFileSpec1 On Error GoTo errorhandle Dim varThis As Variant Dim strBEFileSpec1 As String Dim TabolPath, DataTayb As String TabolPath = "TabelName" DataTay = ".mdb" strBEFileSpec1 = Application.CurrentProject.Path & "\" & TabolPath & DataTay For Each varThis In CurrentDb.TableDefs With varThis If Trim(Nz(.Connect)) Like ";DATABASE=*" Then .Connect = ";DATABASE=" & strBEFileSpec1 .RefreshLink End If End With Next varThis Next varThis MsgBox "تم ربط قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تأكيد الربط" errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description Resume errorhandleexit
    1 point
  28. اخي الكريم لافراغ الجداول استخدم الكود التالي ما اضافة اسم كل جدول DoCmd.RunSQL "DELETE FROM " & "Table Name 1" DoCmd.RunSQL "DELETE FROM " & "Table Name 2" DoCmd.RunSQL "DELETE FROM " & "Table Name 3" لعمل نسخة احتياطية بتاريخ كل يوم استخدم الكود التالي في كود النسخة الاحتياطية سيتم عمل الأتي تلقائيا - انشاء مجلد بإسم Backup - انشاء جدول يتضمن رقم النسخة و مسار النسخة و تاريخها - يتم عمل نسخة مطابقة بالكامل في نفس المجلد 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) End If Dim MyFile, DstFile As String Dim Syso As Object On Error GoTo ErrH MyFile = CurrentProject.FullName DstFile = CurrentProject.Path & "\Backup\Backup-" & Format(Date, "dd-mm-yyyy") & ".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" DoCmd.RunSQL "CREATE TABLE Backup (Backup_NO INT , Backup_Name VARCHAR (50) , Backup_Path VARCHAR (100), Backup_Date Date);" 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] = Format(Date, "dd-mm-yyyy") ![Backup_Path] = DstFile ![Backup_Date] = Now() .Update End With MsgBox "تم انشاء نسخة احتياطية بنجاح" , vbMsgBoxRight + vbOKOnly, "تاكيد" Exit Sub ErrH: Select Case Err.Number End Select
    1 point
  29. تفضل وجدت لك هذا المثال zaCompactAndRepairSplitDatabase.rar تحياتي
    1 point
  30. مرحبا اخي الكريم انت لديك في النموذج cert نموذج فرعي باسم "نموذج فرعي ورقة11" ركز جيداً 11 ومع ذلك تضع المعيار في التقرير =[Forms]![cert]![نموذج فرعي ورقة1].[Form]![الحقل53] وهذا خطأ فلا وجود للنموذج "نموذج فرعي ورقة1" تم التعديل ليكون "نموذج فرعي ورقة1" النقطة الثانية بما ان مصدر خقل "نص76" هو في الاساس من الجدول الفرعي لفما لا نستخدم If [Forms]![cert]![نموذج فرعي ورقة1].[Form]![الحقل51] = تفضل اخي الكريم الملف بعد التعديل test.rar تحياتي
    1 point
  31. ربما يفيدك هذا الموضوع استخراج تاريخ الميلاد والمحافظة والنوع من الرقم القومي
    1 point
  32. السلام عليكم لقد وصلت متأخرا فوجدت الأستاذ جعفر فعل كل شيء ما شاء الله عليه. لذلك سوف أضع مشاركتي على الرغم أنها تشبه كثيرا كود الأستاذ جعفر Dim str_conn As New ADODB.Connection Dim RS As New ADODB.Recordset str_conn.Open "Provider=SQLOLEDB;Integrated Security=SSPI;Initial Catalog=master;Data Source=" & Me.Comp1 Set RS = str_conn.Execute("select GETDATE()") MsgBox RS(0) Set RS = Nothing str_conn.Close Me.Comp1 هو اسم مربع اسم السرفر
    1 point
  33. اخي الكريم بما انك بدءت فتضل هذه البداية من قبلي استمر و اذا استصعب عليك شي فنحن في الخدمة برنامج المخاز.zip
    1 point
  34. تفضل التعديل اخي الكريم wesam.rar
    1 point
  35. السلام عليكم المشكلة كانت فقط فى شهادة الحماية ، و تم حلها بفضل الله اعتقد هذا صعب تحقيقه لان تنزيل النسخة الواحدة يستغرق وقت طويل بسبب حجم الموقع 🙂 و الحمد لله هناك باك اب داخلى على السيرفر و باك اب خارجي ايضا
    1 point
  36. طلبت من الاستاذ محمد طاهر ان يرد على استفسارك مباشرة 🙂 جعفر
    1 point
  37. وعليكم السلام ورحمة الله وبركاته الحمد لله على عودة المنتدى الحقيقة كنت في قلق شديد وارجو من الاستاذ محمد طاهر عمل نسخة احتياطية بيده يوميا اذا امكن فقد كانت هناك تجربة قاسية لموقع اهلا عرب الحمد لله مرة اخرى على عودة المنتدى تحياتي
    1 point
  38. وعليكم السلام-من فضلك شوف هذا الفيديو https://www.youtube.com/watch?v=5FglGNvVcyY
    1 point
  39. بارك الله فيك أستاذنا الفاضل سليم وبعد إذنك لإثراء الموضوع يكون الاختيار النوع والقسم من الخلايا H2 و I2 ويتم كتابة الكود التالي في الخلية G7 =I2 وعند النقر على Run وكانت الخلية I2 فارغة تظهر رسالة " يجب إدخال القسم في الخلية و يتوقف عمل الكود Moujahed 2013.xlsm
    1 point
  40. استبدل اسم الصفحة الى Salim ( لحسن نسح الكود ولصقه بدون مشاكل اللغة العربية) ثم نفذ هذا الكود Option Explicit Dim sh As Worksheet Dim Rg As Range, cel As Range Dim my_formula '+++++++++++++++++++++++ Sub hid_Rows() Application.ScreenUpdating = False show_all For Each cel In Rg.Columns(2).Cells my_formula = _ Application.CountA(cel.Resize(, 4)) If my_formula = 0 Then cel.EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub '++++++++++++++++++++++++++++ Sub show_all() Set sh = Sheets("Salim") Set Rg = sh.Range("B4").CurrentRegion Rg.EntireRow.Hidden = False End Sub الملف مرفق Yesk.xlsm
    1 point
  41. صحيح وهذا سبب ردي لاني فكرت في الامر ووصلت الى هذه الفكرة ثم وجدت بعد مشاهدة ردك ان فكرة الاستاذ صالح مطابقة مع مميزات اكثر ومثال وقبل فكرتي باكثر من عام ولا احب ان يعتقد استاذنا صالح انني احاول ان انسب لنفسي ماليس لي لذا اعتذر منه ولو اني على علم بموضوعة لاشرت للموضوع مباشرة
    1 point
  42. يمكن ذلك بعمل ربط بين الجداول التي تريدها من البرنامج القديم مع برنامجك الجديد ربط وليس استيراد link to the data وليس import table تحياتي
    1 point
  43. السلام عليكم زيادة في الخير هذا كود كنت كتبته , ليس بروعة كود استاذنا ياسر فهو يحتاج لجدول من الاكسيل و لا يعتمد علي نفسه. تحياتي abjad+.rar
    1 point
  44. وعليكم السلام أخي الغالي خالد الرشيدي لكم يسعدني ويشرفني مرورك العطر بالموضوع ومشكور على كلماتك الرقيقة تقبل تحياتي
    1 point
  45. السلام عليكم الاخ الفاضل/ محمد صالح ______حفظه الله جزاك الله خيرا وبوركت يتم تفقيط الكسر لطول 3 ارقام وليس 2 لاني اعتقد ان الكسر للعملة لا يزيد على 3 ارقام والله اعلم عفوا على هذا السؤال في ماذا تحتاج لتفقيط كسر الى بطول 18 رقم ؟ هل يستخدم في تفقيط شي آخر غير العملات ؟ بالنسبة للطلب ان شاء الله ممكن القيام به فقط يحتاج الى دالة رئيسية اخرى تتعامل مع هذه الدالة على شقين مرة للرقم الصحيح واخرى للكسر وربط النتائج مع بعض. اخبرني اذا كان هناك احتياج لها ساقوم بالعمل تقبل تحياتي وشكري
    1 point
  46. أخى الفاضل / خبور خير سلام الله على أهلنا فى اليمن السعيد الشقيق لما هذه الغيبة الطويلة اخى ..تمييز الأعداد المركبة والعقود تكون مفردا منصوبا : 15 جنيها ... 20 جنيها لما لا والحل فى جعبتكم
    1 point
×
×
  • اضف...

Important Information