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

ممكن عمل هذا الكود في الاستعلام ، ولكنك وبسبب اللغة العربية في الكود ، فلن تعرف ان تغير شيء لاحقا ، لهذا السبب ، الافضل عمل وحدة نمطية ، ويمكنك تعديلها بكل بساطة ، اسميتها qry_values ، ونرسل لها قيمة الحقل من الاستعلام (في المثال السابق ، اسم الحقل كان 2020 ) ، وفي الوحدة النمطية تسمية هذا المتغير هو H : Public Function qry_values(H As Integer) As String If H = 0 Or Len(H & "") = 0 Then ' Zero and Null qry_values = "لا يوجد" ElseIf H = 7 Then ' any other value qry_values = "تم الانتهاء" Else ' return the original value qry_values = H End If End Function . ثم نناديها من الاستعلام ، هكذا : . والنتيجة : جعفر 1306.مثال.accdb.zip

تفضل أخي الكريم .... Kan.accdb

اعرض الملف ملف قاعدة بيانات اكسس يحتوي على 3,919,015 سجل ، لتجربة سرعة برنامجك السلام عليكم 🙂 لعمل برنامجك ، فلا يكفي ان تجربه على بضع سجلات ، وانما يجب تجربته على اكبر قدر ممكن من السجلات ، وخصوصا اذا كان برنامجك سيعمل في شبكة 🙂 لذا ، انزل هذا الملف الى مكتبتك ، واعمل منه نسخة لكل تجربة تريد تعملها 🙂 لا اذكر من اين انزلت هذا الملف ، ولكنه من الملفات المفيدة جدا 🙂 قاعدة البيانات هذه ، تحتوي على بيانات وهمية ، وحجم الملف المضغوط حوالي 30 ميجابايت ، بينما عند فك الضغط يكون حجم الملف حوالي 219 ميجابايت ، يمكن انزال برنامج مجاني من هذا الرابط لكي تفك ضغط الملف (انا استعمله كأحد برامجي الاساسية 🙂 ) : https://www.7-zip.org/ جعفر هنا رابط لمقارنة سرعة الحلول ، باستعمال هذا الكم من البيانات : صاحب الملف jjafferr تمت الاضافه 08 ديس, 2020 الاقسام قسم الأكسيس

مشاركة مع استاذي محمد استخدمنا هذا الكود Kill (Me.txt1 & "*.*") تفضل --------->>>>>> حذف محتويات مجلد.accdb

استاذ محسن مرة ثانية و بدون حلقات تكرارية Option Explicit Dim lr Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False lr = Cells(Rows.Count, 1).End(3).Row If lr < 4 Then GoTo exit_Me If Target.Address(0, 0) = "C2" And _ IsDate(Target) And Target.Count = 1 Then Cells(4, 4).Resize(lr - 3).ClearContents With Cells(4, 4).Resize(lr - 3) .Formula = "=A4&TEXT($C$2,""DMMYYYy"")&""PS""" .Value = .Value End With End If exit_Me: Application.EnableEvents = True End Sub amenbkr.xlsm

السلام عليكم ورحمة الله وبركاته تفضل اخوي العزيز .. baynati.xlsm

بعد اذن الاخ حسين لا حاجة للحلقات التكرارية التي ترهق البرنامج (في حال البيانات الكثيرة أكثر من 500 صف) في حين يمكن وضع اليد مباشرة على الخلية المطلوبة بواسطة الدالّة Find Option Explicit Sub find_me() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim RG1 As Range Set ws1 = Sheets("ورقة1") Set ws2 = Sheets("ورقة2") ws2.Cells(7, 2).Resize(4).ClearContents Set RG1 = ws1.Range("A1").CurrentRegion.Columns(2). _ Find(ws2.Range("C3"), Lookat:=1) If Not RG1 Is Nothing Then ws1.Cells(RG1.Row, 1).Resize(, 4).Copy ws2.Cells(7, 2).PasteSpecial (12), Transpose:=True End If Application.CutCopyMode = False ws2.Cells(3, 3).Select End Sub كما يمكن عمل ذلك بمعادلة بسيطة =OFFSET(INDEX(ورقة1!$B$2:$B$9,MATCH($C$3,ورقة1!$B$2:$B$9,0)),,ROWS($A$1:A1)-2) الملف مرفق Adnan.xlsm

حياك الله .... الحمد لله رب العالمين

نعم ..... ولكن اين الفرز في مثالك .... ممكن تدرج لنا مثال حتى يمكن ارشادك للطريقة الممكنه ' هذا الكود لاخفاء القائمة ChangeProperty "AllowShortcutMenus", DB_Boolean, False 'وهذا لاظهارة مرة اخرى ChangeProperty "AllowShortcutMenus", DB_Boolean, True ولكي يعمل الكود يجب اعادة تشغيل القاعدة مرة اخرى

طبق من خيارات الاكسس وازل العلامة من السماح بالقوائم المختصرة الافتراضية

اكتب هذا الكود If IsNull(Texte8) Or Me.Texte8 = "" Then " اكتب الاسم "MsgBox DoCmd.CancelEvent Else DoCmd.OpenReport "mouv", acViewReport End If

السلام عليكم 🙂 هذا المنتدى للتبادل العلمي ، حتى يستفيد منه الجميع ، وليس صاحب الموضوع / السؤال فقط 🙂 فيا ريت ان نضع الاجابة بالتفصيل في الرد (سواء الخطوات او الكود او صور من شاشة البرنامج) ، ولا نتوقف عند ارفاق المرفق الذي به الرد / الجواب ، والسبب هو ، حتى يستطيع الجميع رؤية الرد ومعرفته مباشرة ، دون اللجوء الى انزال المرفق وفهمه 🙂 نعم ، هذا عبء إضافي ، ولكن نتائجه ستكون مثمرة ان شاء الله 🙂 وتذكروا ، هذا مجرد طلب ورجاء ، وليس اجباري 🙂 شكرا جزيلا 🙂 جعفر

جرب هاي : بدل هذا السطر Set Rst1 = db1.OpenRecordset("temp", dbOpenSnapshot) اكتب هذا السطر Set Rst1 = db1.OpenRecordset("Select * FROM temp ORDER BY stuname", dbOpenSnapshot) جعفر

يجب ان يكون هناك القليل من البيانات في الجدول لمعرفة كيفية عمل المعادلات تم اضافة بيانات عشوائية جرب هذا الملف samia.xlsx

الحل في مشاركتي الاخيرة انسخ الكود الى ملفك

Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim lr, x lr = Cells(Rows.Count, 1).End(3).Row If Not Intersect(Target, Range("a4:a" & lr)) Is Nothing Then For x = 4 To lr Cells(x, "d") = Cells(x, "a") & Format(Range("c2"), "mmyyyy") & "PS" Next x End If End Sub 01.xlsm

01.xlsm

استعمل هذا الكود Sub test() Dim lr, x lr = Cells(Rows.Count, 1).End(3).Row For x = 4 To lr Cells(x, "d") = Cells(x, "a") & Format(Range("c2"), "mmyyyy") & "PS" Next x End Sub 01.xlsm

كيف تريد المساعدة والملف محمي بكلمة سر

تفضل بعد اضافة الرصيد المتبقى حركة مخزن.xlsx

جرب هذا الحل وان وجد اشكال نتناقش 😊 يومية مورد.rar

Book1.xlsx

الحمد لله ان تم الامر على خير وجزيت خيرا اخي الكريم

الف الف شكر اخي الكريم جربت الطريقه ال حضرتك قولتها و نفعت على اي صف شكرا جزيلا

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

حاول تطبيق ما في الصورة 1 في نفس الصفحة يمكنك تطبيق ما في الصورة 2 في صفحة اخرى يمكنك عمل نفس الكود مع اي نطاق تريد

بالاضافة الى ما تفضل به استاذنا jjafferr وله الشكر اخي الكريم استخدم + بديلا عن And كالتالي saves: (Nz(DSum("save";"tabl1";"code=" & [code]);0))+(Nz(DSum("ahmed";"tabl1";"code=" & [code]);0)) AA1.rar تحياتي

مشاركة مع استاذ جعفر ارجو ان تكون موفقة aaa.rar

السلام عليكم ورحمة الله وبركاته فكرة بسيطة لترجمة الاسماء باللغة العربية الى اللغة الانجليزية ممكن تجربته names.xlsm

تم تعديل مثال اخونا Kanory ليعمل على النواتين 32بت و 64بت ، وبصيغة mdb 🙂 جعفر Kan_Fonts.zip

وعليكم السلام عليك بتتبع هذه الفيديوهات فستدلك على افضل الطرق تحويل الاسماء من العربي للانجليزى تلقائيا اكسل ترجمة الاسماء_تحويل كم كبير من الأسماء المكتوبة باللغة العربية إلى الانجليزية بضغطة زر

وعليكم السلام 🙂 لعمل استعلام توحيد ، هناك شرط واحد فقط ، وهو تساوي عدد الحقول الظاهرة (الغير مخفية) في كل استعلام. الاستعلام الاول يرسل بيانات 5 حقول الى الوحدة النمطية dm (وهذا غير مهم بالنسبة الى استعلام التوحيد) ، ولكن المهم ان الاستعلام فيه حقل واحد فقط : SELECT dm([Numéro de compte],[Clé],[montant global],[nombre de bénificiaires],[Mois],[Année]) AS LIGNECD FROM tbl2 . والاستعلام الثاني يرسل بيانات 4 حقول الى الوحدة النمطية cd (وهذا غير مهم بالنسبة الى استعلام التوحيد) ، ولكن المهم ان الاستعلام فيه حقل واحد فقط : SELECT cd([N° compt CCP],[Cle CCP],[Montant],[Nom &Prénom &fr]) AS LIGNECD FROM tbl1 . لهذا السبب تمكنا من توحيد الاستعلامين في استعلام واحد. اما الاستعلام الجديد (احد الاستعلامات الجديدة) فهو يحتوي على 6 حقول : SELECT Employee.[N° compt CCP],Employee.[Cle CCP],Employee.[Nom &Prénom &fr], +1 AS TheType, Sum(Cridi.Cridi_Value) AS SumOfCridi_Value, -1 AS M FROM Employee INNER JOIN Cridi ON Employee.EmployeeID = Cridi.EmployeeID GROUP BY Cridi.EmployeeID, Employee.[Nom &Prénom &fr], Employee.[N° compt CCP],Employee.[Cle CCP], +1, "Cridi", Month([Cridi_Date]), Year([Cridi_Date]) HAVING (((Month([Cridi_Date]))=Month(CDate([Forms]![FrmTransfer]![txtMonth]))) AND ((Year([Cridi_Date]))=Year(CDate([Forms]![FrmTransfer]![txtMonth])))) فلا يمكن توحيد الاستعلام ذو الحقل الواحد (الاستعلام الاول) ، مع هذا الاستعلام ذو الاكثر من حقل واحد. جعفر

لا يوجد لدي جهاز حاليا فيه 64 بت ولكن جرب هذا ..... Kan.accdb

'TempVars.Add Name, Value 'Name >>--> حيث يكون الاسم هو اسم المتغير الخاص بك 'Value >>--> حيث تكون القيمة التي ترغب في تخصيصها له بعض الأمثلة: TempVars.Add "strName", "officena" TempVars.Add "lngID" , 1 TempVars.Add "boSure" , true - طريقة تمرير قيمة حسب اسم المتغير TempVars![Name] - طريقة ازالة القيمة من كل المتغيرات TempVars.RemoveAll - طريقة ازالة القيمة من متغير محدد TempVars.Remove "Name" وهذا مثال يجمع الطريقتين 1905137138_PassingavariableWey.mdb Passing a variable Wey.zip

قام اباجودي بوضع المثال هنا

قضلا وكرما وليس امرا اخى الحبيب ومعلمى واستاذى الجليل استاذ @أبو عبدالله الحلوانى ممكن تعيد التجربة وتوافينى بالنتيجة تعديل.zip

أهلا بك عزيزي أبا جودي.. لاحظ في المثال المرفق أن ألنموذج لا يعتمد على الجدول المرتبط بالطريقة المباشرة.. أبقيت على شفرة الربط الخاصة SQL SERVER للفائد.. LINKED DATA.ZIP

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

اذن اخي من الاحسن ان تستعمل هذ الكود الذي طرحته في مشاركة سابقة Private Sub Worksheet_Selectionchange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select ElseIf Target.MergeCells = True And Target.HasFormula = True Then Target.Offset(0, 1).Select ElseIf ActiveCell.HasFormula = True And ActiveCell.MergeCells = True Then ActiveCell.Offset(0, 1).Select End If End Sub