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

أهلا بالجميع... من الممكن تطبيق الفكرة بواسطة أكسس بواسطة عناصر ActiveX القياسية المتوفرة ضمن عناصر التحكم.. في المثال المرفق استخدمت Picturelip و Image (عناصر ActiveX) من أجل تحقيق المطلوب يقوم العنصر PictureClip بتقطيع الصور بناء على عدد الأعمدة والصفوف التي يحددها المستخدم... بعد ذلك نقوم بإسناد الصورة المقطوعة إلى العنصر Image من أجل العرض.. عند النقر على رقم الصورة المعروضة يتم حفظها منفردة.. أترككم مع المثال ونناقش فيما بعد الحفظ التلقائي.. MSAccess With PictureClip.zip

جرب هذا الكود 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

تم وضع كود عند أي تغيير يحدث في tbxName يظهر رقم تسلسل للاسم الجديد وتم وضع ماكرو كود ترقيم سميت Tمن أعمال أستاذنا الفاضل سليم حاصبيا حتى إذا أردت حذف فيقوم بإعادة الترقيم العمودA بشرط لا تكون الخلية المجاورة B فارغة نموذج المطلوب-1.xlsm

أهلا بك @hamdy1111 هذا يعني أن مكتبة تقطيع الصور ليست على نظامك.. أرفقت مع المثال نسخة من المكتبة ضمن المثال المرفق. قم بإعادة تحميله؛ وأتبع الخطوات التالية .. إذا كان نظامك على معمارية 64bit: قم بنسخ المكتبة وضعها في المجلد (sysWOW64). .. إذا كان نظامك على معمارية 32bit: قم بنسخ المكتبة وضعها في المجلد (system32). .. أعد تشغيل ملف أكسس.

ممكن أن تكون المعادلة هكذا =IF(ورقة1!A1="";"";9+9) أو =IF(ورقة1!A1="","",9+9) أي أنه لو الخلية A1 في ورقة 1 فارغة لا يتم حساب شيء أما إذا كانت غير فارغة اجمع 9+9 تبع إعدادات جهازك الفاصلة أم الفاصلة المنقوطة

العفو اخي صالح انتم اكبر من ذلك ولكن كان الايضاح لحاجة في نفس يعقوب نعود للفكرة الرابط بين قاعدة البيانات في جهاز العميل والسيرفر الجداول ملف موجود على السيرفر ويتم الاشارة الى مكان وجودة في قاعدة بيانات العميل روابط اخرى تتعلق بالصلاحيات وطريقة تعريف الاجهزة والتحكم بها ولكن هنا نكون انتقلنا الى مسار اكثر احترافية وتعقيدا برامج خارجية للتحكم بالاجهزة وقد اشرت الى احدهم في مشاركتي الاولى لذا فاي مبرمج سوف يقترح احد هذه الحلول الحل الاسهل حقل في الجدول ثم كود عند عداد الوقت او امر محاكي لعداد الوقت وهو ما اشرت اليه في ردي كفكرة وسبقتوني اليه باكثر من عام الحل الثاني ملف موجود على السيرفر وتم التطرق اليه في رد الاخ @jjafferr في موضوع مختلف قليلا ولكن يمكن استخدامه مع اجراء بعض التعديل ليقوم بالاغلاق لجهاز العميل if Dir("D:\Test\AMIN.xls") ="" then msgbox "لم يتم الحصول على الملف المطلوب" exit sub 'اخرج من البرنامج endif الحل الثالث المح اليه الاستاذ @أ / محمد صالح باستفسار من صاحب الموضوع وهو متعلق بصلاحيات الادارة للاجهزة المرتبطة الحل الرابع وهو البرنامج الخارجي وتختلف المميزات باختلاف البرنامج فبعضها يعطي صلاحيات التحكم في التعديل والاغلاق وبعضها اضافة لذلك يمتاز بارسال رسائل فورية للمستخدمين قالت العرب "الافكار كالحجارة ملقاة في الطريق يعرفها العربي والعجمي وإنما الشأن في إقامة الوزن وتخير اللفظ وسهولة المخرج وجودة السبك فإنما الشعر صناعة وضرب من النسج وجنس من التصوير" وكذلك الامر في كل امر بما فيها البرمجة الفكرة موجودة والفن في جودة التنفيذ وهذا في صالحكم اخي الفاضل 🌹 تحياتي وتقديري

بارك الله فيك استاذ محمد ولإثراء الحل -يمكنك استخدام هذه الدالة المعرفة 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

السلام عليكم 🙂 الموقع كان فيه عطل فني يوم الاثنين وصباح الثلاثاء ، والاستاذ محمد مدير الموقع كان متابع الموضوع 🙂 للعلم 🙂 جعفر

دالة datedif موجودة في جميع إصدارات إكسل ولكنها غير موجودة في قائمة الدوال ولا تظهر في الإكمال التلقائي نظرا لاختلاف عالمي في طريقة حساب الفرق بين تاريخين ويمكنك الاستفادة من هذا الرابط https://www.mr-mas.com/p/datedif.html لخساب الفرق بين تاريخين أونلاين وفي برنامج ميكروسوفت إكسيل

صحيح 👇

ومافي اي اشكال من يوم الثلاثاء والحمد لله 🙂 رجاء تخبرنا عن اسم المتصفح ورقم النسخة . جعفر

العفو أستاذ ابوطيبه (ابوفهد) العبارة : تم وضع كود عند أي تغيير يحدث في tbxName يظهر رقم تسلسل للاسم الجديد أي أنه عند إضافة اسم جديد فإنه سيتم ترقيم TextBox1 وبالتالي عند الترحيل سيتم الترقيم في العمود A

السلام عليكم 🙂 من تجربتي مع هذه الملفات ، للأسف الشديد ما ممكن عمل اصلاح لها ، وحتى اني رفعت احدها لأحد الشركات المتخصصة في استرجاع البيانات ، ولكن للأسف بدون فائدة !! نعم ، اذا كانت الجداول موجودة ، فهناك امل في استرداد البيانات بإستعمال برامج خارجية ، مثل هذه : جعفر

تفضل التعديل اخي الكريم 22.accdb

فكرة رائعة اخوي ابو ابراهيم 🙂 يعني لازم نبحث في برامج OCX ونشوف اللي ممكن تعمله 🙂 جعفر

شاكر ومقدر تعبك اخي لكني اذا اضفت القاعدة يطلعلي غير مسموح لك برفع ملف بهذا الحجم مسموح لك بهذه المساحه ١٬٠٠٣٫٥٢كيلو بايت

وعليكم السلام .. تم تحرير عمود الكمية 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

الله يحغظك يا عالي أنا أعلم ذلك و لو كنت مكانك لفعلت نفس الشيء لأن هذه هي صفاة أصحاب العلم بالنسبة للموضوع لقد طرحت 4 أفكار مختلفة و جيدة لكن يجب أن نضع في الحسبان جيدا أن أمر الصلاحيات و التحكم عن بعد فيها الكثير من الخطر لو وقعت في أياد غير أمينة

فكرة ممتازة أخي ابا ابراهيم ::::: تشكر

ماشاء الله عليك ابو ابراهيم اتابع بصمت ......

دالة DATEDIF موجودة في نسخ الإكسيل حتى عام 2000 أما بعد ذلك لم تعد موجودة ضمن الدوال ولكن إذا كتبت الدالة فإنها تعمل

وعليكم السلام-لا يوجد دالة اصلاً بهذا الإسم .... الدالة اسمها DATEDIF وليس Dateif

الله عليك استاذنا القدير / @kha9009lid شرح واضح ورائع باربع طرق وكما اشار استاذنا القدير القمة / @jjafferr المنتدى دسم بالمعلومات لكن الذى جعلنى ان اضع مشاركتى هنا وهو الحكمة التى ذكرها استاذنا / خالد ففيها معنى كبير للحياة والتطبيق على كل مراحل العلم منها طبعا البرمجة حلوة جدا جدا هذه الحكمة واذا سمح لى استاذنا خالد ان استعيرها فى بعض الامور لى جزاكم الله خيرا على هذا الحضور القوى والهام لنا كطلبة لديكم .

لم اسىء الظن بك اخي الكريم بارك الله فيك ولكني اقوم بالتنبيه فقط تحياتي

مختار هذا بالنسبة للنموذج ولكنك لم تضع معيار او فلتر للتقرير DoCmd.OpenReport "sc", acViewPreview, , "[jname] ='" & Me.jname & "'" test.rar تحياتي

اخي الكريم للربط مع قاعدة البيانات يجب اولا احضار عنوان السيرفر و كذلك كلمة المرور و اسم المستخدم لاضافة السورس الخاص بالاتصال X1= عنوان السيرفر X2= كلمة المرور X3= اسم المستخدم Data Source=X2;Persist Security Info=True;User ID=X2;Password=X3 الان اتبع الصور لانشاء اتصال و ربط بقاعدة البيانات الاخرى

جزاك الله كل خير على هذا الاسلوب الرائع فعلا لا تطعمني كل يوم سمكة ولكن علمني كيف اصيد اشكرك اخي محمد

تفضل هذا الكود اخي الكري مع مراعاة التغيير حسب المتغيرات الاسم و صيغة قاعدة البيانات كما يمكنك تثبيت موقع قاعدة البيانات من خلال تثبيت القيمة للمتغيير 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

اخي الكريم لافراغ الجداول استخدم الكود التالي ما اضافة اسم كل جدول 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

تفضل وجدت لك هذا المثال zaCompactAndRepairSplitDatabase.rar تحياتي

مرحبا اخي الكريم انت لديك في النموذج cert نموذج فرعي باسم "نموذج فرعي ورقة11" ركز جيداً 11 ومع ذلك تضع المعيار في التقرير =[Forms]![cert]![نموذج فرعي ورقة1].[Form]![الحقل53] وهذا خطأ فلا وجود للنموذج "نموذج فرعي ورقة1" تم التعديل ليكون "نموذج فرعي ورقة1" النقطة الثانية بما ان مصدر خقل "نص76" هو في الاساس من الجدول الفرعي لفما لا نستخدم If [Forms]![cert]![نموذج فرعي ورقة1].[Form]![الحقل51] = تفضل اخي الكريم الملف بعد التعديل test.rar تحياتي

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

السلام عليكم لقد وصلت متأخرا فوجدت الأستاذ جعفر فعل كل شيء ما شاء الله عليه. لذلك سوف أضع مشاركتي على الرغم أنها تشبه كثيرا كود الأستاذ جعفر 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 هو اسم مربع اسم السرفر

اخي الكريم بما انك بدءت فتضل هذه البداية من قبلي استمر و اذا استصعب عليك شي فنحن في الخدمة برنامج المخاز.zip

تفضل التعديل اخي الكريم wesam.rar

السلام عليكم المشكلة كانت فقط فى شهادة الحماية ، و تم حلها بفضل الله اعتقد هذا صعب تحقيقه لان تنزيل النسخة الواحدة يستغرق وقت طويل بسبب حجم الموقع 🙂 و الحمد لله هناك باك اب داخلى على السيرفر و باك اب خارجي ايضا

الحمدلله فعلا كان يرفض الدخول معي

طلبت من الاستاذ محمد طاهر ان يرد على استفسارك مباشرة 🙂 جعفر

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

وعليكم السلام-من فضلك شوف هذا الفيديو https://www.youtube.com/watch?v=5FglGNvVcyY

بارك الله فيك أستاذنا الفاضل سليم وبعد إذنك لإثراء الموضوع يكون الاختيار النوع والقسم من الخلايا H2 و I2 ويتم كتابة الكود التالي في الخلية G7 =I2 وعند النقر على Run وكانت الخلية I2 فارغة تظهر رسالة " يجب إدخال القسم في الخلية و يتوقف عمل الكود Moujahed 2013.xlsm

استبدل اسم الصفحة الى 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

صحيح وهذا سبب ردي لاني فكرت في الامر ووصلت الى هذه الفكرة ثم وجدت بعد مشاهدة ردك ان فكرة الاستاذ صالح مطابقة مع مميزات اكثر ومثال وقبل فكرتي باكثر من عام ولا احب ان يعتقد استاذنا صالح انني احاول ان انسب لنفسي ماليس لي لذا اعتذر منه ولو اني على علم بموضوعة لاشرت للموضوع مباشرة

يمكن ذلك بعمل ربط بين الجداول التي تريدها من البرنامج القديم مع برنامجك الجديد ربط وليس استيراد link to the data وليس import table تحياتي

السلام عليكم زيادة في الخير هذا كود كنت كتبته , ليس بروعة كود استاذنا ياسر فهو يحتاج لجدول من الاكسيل و لا يعتمد علي نفسه. تحياتي abjad+.rar

وعليكم السلام أخي الغالي خالد الرشيدي لكم يسعدني ويشرفني مرورك العطر بالموضوع ومشكور على كلماتك الرقيقة تقبل تحياتي

السلام عليكم الاخ الفاضل/ محمد صالح ______حفظه الله جزاك الله خيرا وبوركت يتم تفقيط الكسر لطول 3 ارقام وليس 2 لاني اعتقد ان الكسر للعملة لا يزيد على 3 ارقام والله اعلم عفوا على هذا السؤال في ماذا تحتاج لتفقيط كسر الى بطول 18 رقم ؟ هل يستخدم في تفقيط شي آخر غير العملات ؟ بالنسبة للطلب ان شاء الله ممكن القيام به فقط يحتاج الى دالة رئيسية اخرى تتعامل مع هذه الدالة على شقين مرة للرقم الصحيح واخرى للكسر وربط النتائج مع بعض. اخبرني اذا كان هناك احتياج لها ساقوم بالعمل تقبل تحياتي وشكري

أخى الفاضل / خبور خير سلام الله على أهلنا فى اليمن السعيد الشقيق لما هذه الغيبة الطويلة اخى ..تمييز الأعداد المركبة والعقود تكون مفردا منصوبا : 15 جنيها ... 20 جنيها لما لا والحل فى جعبتكم