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

السلام عليكم ورحمة الله وبركاته .. تحية طيبة إخواني .. 🌹 أحضرت لكم اليوم كود وظيفته استخراج الملفات المخزنة في جداول الأكسس كمرفقات داخلية إلى خارج قاعدة البيانات دفعة واحدة 🙂 وهو مفيد جدا لمن لديه قاعدة بيانات قد ملئها بالمرفقات ويحاول الآن تصغير القاعدة باستخراج المرفقات منها وحفظها خارج قاعدة البيانات بسهولة ويسر .. بدل حفظها ملف ملف وهي عملية مرهقة بالتأكيد .. خصوصا إذا كان عدد المرفقات بالمئات .. إليكم الكود : Public Function ExtractAllAttachments(ByVal TableName As String, ByVal AttchmentColumnName As String, ByVal ExtractToFolder As String) ' TableName : اسم الجدول ' AttchmentColumnName : اسم حقل المرفقات ' ExtractToFolder: المكان المراد استخراج الملفات إليه مثال : "C:\ExtractHere" Dim RsMainrecords As dao.Recordset2 Dim RsAttachments As dao.Recordset2 Set RsMainrecords = CurrentDb.OpenRecordset("select " & AttchmentColumnName & _ " from " & TableName & _ " where " & AttchmentColumnName & ".FileName is not Null") Do Until RsMainrecords.EOF Set RsAttachments = RsMainrecords.Fields(AttchmentColumnName).Value Do Until RsAttachments.EOF Dim OutputFileName As String OutputFileName = RsAttachments.Fields("FileName").Value OutputFileName = ExtractToFolder & "\" & OutputFileName RsAttachments.Fields("FileData").SaveToFile OutputFileName RsAttachments.MoveNext Loop RsAttachments.Close RsMainrecords.MoveNext Loop RsMainrecords.Close Set RsMainrecords = Nothing Set RsAttachments = Nothing End Function ويتم تشغيله بالطريقة التالية : ExtractAllAttachments("TableName","AttchmentColumnName","ExtractToFolder") ستحتاج لإعطائه 1- اسم الجدول ، 2 - اسم الحقل ، 3 - المكان الذي تريد استخراج المرفقات فيه . المصدر : https://www.youtube.com/watch?v=jHIgay9goWo

Sub Test() GenerateUniqueRandom ActiveSheet, "D3:F22", 1, 60 End Sub Sub GenerateUniqueRandom(ByVal shTarget As Worksheet, ByVal sRng As String, ByVal iStart As Long, iEnd As Long) Dim w, v, rng As Range, c As Range, n As Long, i As Long, ii As Long, r As Long Set rng = shTarget.Range(sRng) If iEnd - iStart + 1 > rng.Cells.Count Then MsgBox "Generated Numbers Greater Than Range Cell Count", vbExclamation: Exit Sub w = Evaluate("ROW(" & iStart & ":" & iEnd & ")") n = 0 ReDim v(1 To rng.Rows.Count, 1 To rng.Columns.Count) For i = LBound(v, 1) To UBound(v, 1) For ii = LBound(v, 2) To UBound(v, 2) r = Application.RandBetween(iStart, UBound(w) - n) v(i, ii) = w(r, 1) w(r, 1) = w(UBound(w) - n, 1) n = n + 1 Next ii Next i rng.Cells(1).Resize(UBound(v, 1), UBound(v, 2)).Value = v End Sub

تفضل يمكنك استخدام هذه الدالة المعرفة =RandomNumbers(1,60,0) Public Function RandomNumbers(Num1 As Long, Num2 As Long, Optional Decimals As Integer) Application.Volatile Randomize If IsMissing(Decimals) Or Decimals = 0 Then RandomNumbers = Int((Num2 + 1 - Num1) * Rnd + Num1) Else RandomNumbers = Round((Num2 - Num1) * Rnd + Num1, Decimals) End If End Function عدم التكرار.xlsm

السلام عليكم ورحمة الله بعد عودة المنتدى مرة اخرى شيت كنترول الصف الاول بعد اعادة ترتيب مادة الجغرافيا مما استلزم اعادة الترتيب لحوالى خمس اوراق اخرى و تعديل ما يقرب من عشر اكواد كنترول اولى.xlsm

بارك الله فيك استاذ موسى وزادك الله من فضله ... وكل عام وانتم بخير

بامكانك استخدام المعادلة ادناه والتعديل عليها حسب كل خلية حيث ان التنسيق من الاساس في الخلايا غير موحد =LEFT(A2,SEARCH(" ",A2))&" "&MID(A2,SEARCH(" ",A2,1)+1,SEARCH(" ",A2,SEARCH(" ",A2,1)+1)-SEARCH(" ",A2,1))&" "&RIGHT(A2,LEN(A2)-SEARCH(" ",A2,SEARCH(" ",A2,SEARCH(" ",A2)+1))) انظر للمرفق تصحيح مشكلة في الاسماء.xls

السلام عليكم ورحمة الله وبركاته إليكم مثال في فتح فورم بطريقة جميلة وشكرا فتح نموذج.rar

شكرا لك أخي عبدالقدوس 🙂

تم التعديل تفضل أخي AMINYOUSIF الكود بعد التعديل : Me.Refresh DoCmd.SetWarnings False DoCmd.OpenQuery "UPDATA_PRICE_CLASS_YES" DoCmd.SetWarnings True Me.F_PRICE_CLASS.Requery UP_PRICE.rar

السلام عليكم ورحمة الله تعالى وبركاته من حين لآخر قد نستخدم برامج محمولة بتمرير قيم اليها لاجراء بعض العمليات من خلال الـ Command Line ولكن احيانا تعلق بالذاكرة ولا يتم إغلاق البرامج بشكل صحيح وبالتالي تسبب الصداع والمشاكل التى تجعلك غير قادر على معاودة العمل مرة أخرى لذلك قد يصبح من الضروري إنهاء العملية بالقوة بقتل التطبيق العالق فى الذاكرة اقدم لكم وظيفة بسيطة تقوم بتمرير الاسم الكامل للعملية المطلوب إنهاؤها فقط Public Function WMI_KillProcess(sProcessName As String, Optional sHost As String = ".") As Boolean On Error GoTo Error_Handler Dim oWMI As Object 'WMI object to query about the PC's OS Dim sWMIQuery As String 'WMI Query Dim oCols As Object Dim oCol As Object Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2") sWMIQuery = "SELECT Name FROM Win32_Process" Set oCols = oWMI.ExecQuery(sWMIQuery) For Each oCol In oCols If LCase(sProcessName) = LCase(oCol.Name) Then oCol.Terminate ' Kill this instances of the process End If Next oCol WMI_KillProcess = True Error_Handler_Exit: On Error Resume Next Set oCol = Nothing Set oCols = Nothing Set oWMI = Nothing Exit Function Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: WMI_KillProcess" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function ويتم استدعاء الوظيفة من خلال السطر الاتى Call WMI_KillProcess("calculator.exe") طبعا تغير اسم التطبيق العالق والذى تريد انهاءه بالقوة بدلا من calculator.exe وهذا مثال للتوضيح KillProcess.accdb

رمضان كريم ... انظر المرفق اخي Total Suppliers Invoice - Copy.xlsm

أحسنت أستاذ ابراهيم عمل ممتاز جعله الله فى ميزان حسناتك

بعد اذن استاذنا الكريم محمد-يمكنك استخدام هذه المعادلة بالتنسيقات الشرطية =AND(COUNT($A2:$D2)<>0,A2=MAX($A2:$D2)) 111.xlsx

وعليكم السلام -يجب عليك التمهل .فانت لا تعرف مدى انشغال الأساتذة - تفضل تم التعديل فاتورة1.xlsm

أحسنت استاذ مجدى بارك الله فيك وجعله الله فى ميزان حسناتكم ... وكل عام وأنتم بخير

بارك الله فيك وجزاك الله خير الثواب

أحسنت استاذ ماجد بارك الله فيك

تمام ببساطة -يمكنك استخدام هذه المعادلة للتسلسل للتخلص من هذه المشكلة .. وبالتالى كده تم اكتمال طلباتك =AGGREGATE(2,5,$A$1:A1)+1 ياسمين 2.xlsx

احسنت استاذ أبو عيد عمل ممتاز جعله الله فى ميزان حسناتك

وعليكم السلام-يمكنك جعل المعادلة هكذا =SUMIFS($C$3:$C$7,$D$3:$D$7,$I3,$B$3:$B$7,J$2,$A$3:$A$7,">="&H3,$A$3:$A$7,"<="&EOMONTH(H3,0)) work1.xlsx

وعليكم السلام -بسيطة , تفضل المثال 1 _xlsm.xlsm

عمل ممتاز جزاك الله كل خير

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