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

السلام عليكم ورحمة الله استخدم هذا الكود و قم بتغيير اسم ملف الصور الى Pics و اجعل ملف الاكسل خارج ملف الصور و ليس داخله Sub AddPics() Dim ws As Worksheet, C As Range Dim EmpName As String, T As String, Dpath As String Dim pic As Object Application.ScreenUpdating = False Set ws = Sheets("ورقة1") For Each pic In ws.Pictures pic.Delete Next pic On Error Resume Next Set C = ws.Range("B2:B5") EmpName = ws.Range("A5").Value Dpath = ActiveWorkbook.Path & "\" myDir = Dpath & "Pics" & "\" T = ".jpg" On Error Resume Next ws.Shapes.AddPicture Filename:=myDir & EmpName & T, _ linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=C.Left, _ Top:=C.Top, Width:=C.Width, Height:=C.Height Application.ScreenUpdating = True End Sub

السلام عليكم وصلتنا أكثر من شكوي بشأن عدم تفعيل الترقيات الالية تمت مراجعة الأمر و حاليا سيتم التفعيل باذن الله مع أول دخول أو مع اضافة أول مشاركة الترقيات الالية الحالية كالتالي: عند التسجيل: عضو جديد عند بلوغ 50 مشاركة : عضو عند بلوغ 100مشاركة : عضو مميز عند بلوغ 500 مشاركة : عضو فضي عند بلوغ 1000 مشاركة : عضو ذهبي عند بلوغ 2000 مشاركة: عضو ماسي و يستثني من الترقيات الالية مجموعات الخبراء و فريق الموقع الحالي و السابق و العضوية الشرفية

المشكلة سهلة جداً (على فكرة أين الاعجاب) فقط اضافة سطر واحد على الكود(ما بين علامات +++++++) '+++++++++++++++++++++++++++++++++++++++++++++++ ARCHIVE.Range("b2").CurrentRegion.Sort key1:=ARCHIVE.Range("h2"), Header:=1 '++++++++++++++++++++++++++++++++++++++++++++++++ ليصبح الكود هكذا Option Explicit Sub hide_rows() Dim my_rg As Range Dim Copy_Rg As Range Dim find_Rg As Range Dim St$: St = "انتهى" Dim R%, Ro%, x% Application.ScreenUpdating = False ARCHIVE.Range("b2").CurrentRegion.Offset(1).Clear Set my_rg = Main.Range("b3").CurrentRegion.Columns(1) x = my_rg.Rows.Count Set find_Rg = my_rg.Find(St, after:=my_rg.Cells(x)) If Not find_Rg Is Nothing Then R% = find_Rg.Row: Ro = R Main.Range("b" & Ro).EntireRow.Hidden = True Do If Copy_Rg Is Nothing Then Set Copy_Rg = Main.Range("b" & Ro).Resize(, 10) Else Set Copy_Rg = Union(Copy_Rg, Main.Range("b" & Ro).Resize(, 10)) End If Set find_Rg = my_rg.FindNext(find_Rg) Ro% = find_Rg.Row Main.Range("b" & Ro).EntireRow.Hidden = True If Ro = R Then Exit Do Loop Copy_Rg.Copy ARCHIVE.Range("b2") ARCHIVE.Columns("b:k").AutoFit End If '+++++++++++++++++++++++++++++++++++++++++++++++ ARCHIVE.Range("b2").CurrentRegion.Sort _ key1:=ARCHIVE.Range("h2"), Header:=1 '++++++++++++++++++++++++++++++++++++++++++++++++ Application.ScreenUpdating = True End Sub '============================================ Sub show_all() Application.ScreenUpdating = False Main.Rows.Hidden = False Application.ScreenUpdating = True End Sub Sort_hide_special_rows.xlsm

السلام عليكم و رحمة الله و بركاته البرنامج بسيط بحيث يتم ادراج حركات لزيادة جمال واجهات البرنامج الخاص بك , علّه يستفيد أحد الأخوة منه .. المثال منقول للأمانة حركات ضمن النموذج.mdb

السلام عليكم جرب المرفق... بن علية حاجي حصص الاحتياط.xlsm

السلام عليكم, في سنة 2017 قمت بكتابة كلاس بسيط لحماية برنامجي ولضمان برنامجي لا يعمل في غير كومبيوترات في حاله بيعه. مميزات الكلاس: 1- قفل قاعدة البيانات على ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) 2- (استحاله) فك النماذج والتقارير في حال عدم تجاوزك لنموذج ( تسجيل الدخول ) ببساطة ستقول يمكنني العثور على باسورد القاعدة داخل الجدول ( الطريقة المعتادة لدينا جميعا في انشاء نموذج تسجيل دخول ). قبل كل شي ليكن لدينا مثلا جدول اسمة ( tbl_Login ) و نموذج اسمه ( frm_Login ) الجدول لتخزين اسم المستخدم وكلمة المرور والنموذج لعمل تسجيل الدخول عند ذهابنا للجدول ( tbl_Login ) ، سوف نحصل على باسورد مشفر من الجدول لو كان الباسورد مثلا ( 313 ) فإنك ستحصل على ( 701D6068 ) 2- عندما نقوم بتسجيل الدخول في النموذج سيقوم البرنامج بأخذ كلمة السر المدخلة ويقوم بتشفيرها ثم يقوم بمطابقتها مع الباسورد الموجود في الجدول اذا كان الباسورد المُدخل يطابق الجدول سيكتب قيمة معينة runtime ويقوم بازالة جميع القيود من النماذج والتقارير. اولا: كلاس الحماية Option Compare Database '----------------------------------------------------- ' Protection Module Coded By Hassanein Hirz Aldeen (SEMO.Pa3x) ' Date 26/11/2017 ' All rights reserved. copyright © 2017 '----------------------------------------------------- Public SEMO As String Function SEMO_GET() SEMO = SEMO SEMO_GET = SEMO End Function Function PR() As Boolean PR = False 'False=Disabled , True=Enabled End Function Function HWND_ID() HWND_ID = "3C3F4825" 'Your HWID End Function Function HWND_MSG() HWND_MSG = "...ليست لديك صلاحيات كافية لإستخدام هذا الاجراء" End Function Function KEY_ENDE() KEY_ENDE = "PA$X" End Function Function HWND_GET() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_GET = disk.volumeserialnumber Exit For End If Next End Function Function HWND_PROTECTION() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_PROTECTION = disk.volumeserialnumber Exit For End If Next If HWND_ID = HWND_PROTECTION Then HWND_PROTECTION = "True" Else HWND_PROTECTION = "False" End If End Function 'Code contained within module named mdlforencryptionanddecryption Public Function XORDecryption(CodeKey As String, DataIn As String) As String Dim arkdata1 As Long Dim strDataOut As String Dim intXOrValue1 As Integer Dim intXOrValue2 As Integer For arkdata1 = 1 To (Len(DataIn) / 2) 'The first value to be XOr-ed comes from the data to be encrypted intXOrValue1 = Val("&H" & (Mid(DataIn, (2 * arkdata1) - 1, 2))) 'The second value comes from the code key intXOrValue2 = Asc(Mid(CodeKey, ((arkdata1 Mod Len(CodeKey)) + 1), 1)) strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2) Next arkdata1 XORDecryption = strDataOut End Function Public Function XOREncryption(CodeKey As String, DataIn As String) As String Dim arkdata1 As Long Dim strDataOut As String Dim temp As Integer Dim tempstring As String Dim intXOrValue1 As Integer Dim intXOrValue2 As Integer For arkdata1 = 1 To Len(DataIn) 'The first value to be XOr-ed comes from the data to be encrypted intXOrValue1 = Asc(Mid$(DataIn, arkdata1, 1)) 'The second value comes from the code key intXOrValue2 = Asc(Mid$(CodeKey, ((arkdata1 Mod Len(CodeKey)) + 1), 1)) temp = (intXOrValue1 Xor intXOrValue2) tempstring = Hex(temp) If Len(tempstring) = 1 Then tempstring = "0" & tempstring strDataOut = strDataOut + tempstring Next arkdata1 XOREncryption = strDataOut End Function الاستخدام لكل النماذج والتقارير اكتب في حدث Form_Load Option Compare Database Private Sub Form_Load() On Error Resume Next If HWND_PROTECTION = "False" Then MsgBox HWND_MSG, vbCritical, "عملية خاطئة" For i = 0 To Controls.Count - 1 Dim X As Control Set X = Me.Controls.Item(i) X.Visible = False Next DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit End If If Protection.SEMO_GET = "SEMO" = False Then MsgBox HWND_MSG, vbCritical, "عملية خاطئة" For i = 0 To Controls.Count - 1 Dim XS As Control Set XS = Me.Controls.Item(i) XS.Visible = False Next DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit End If End Sub الان عندما تريد اعطاء القاعدة لشخص ما قم باعطاءه اولا ملف الـ VBS هذا '----------------------------------------------------- ' ReCoded By Hassanein Hirz Aldeen (SEMO.Pa3x) ' Date 26/11/2017 ' All rights reserved. copyright © 2017 '----------------------------------------------------- ' Get clipboard text Set objHTML = CreateObject("htmlfile") Set Ws = CreateObject("WScript.Shell") Clipboardtext = objHTML.ParentWindow.ClipboardData.GetData("text") sText = HWND_GET 'Set Clipboard Ws.Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True MsgBox "Copied!" Function HWND_GET() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_GET = disk.volumeserialnumber Exit For End If Next End Function وظيفة هذا الملف يقوم باستخراج ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) ثم ينسخه بعدما يشغله سيقوم العميل باعطاءك هذا الرقم لكي تقوم انت بدورك بوضعه داخل الكلاس في المنطقة Function HWND_ID() HWND_ID = "Your HWID" End Function استبدل كلمة ( Your HWID ) بالرقم الذي سيعطيه لك العميل. ثم بعد ذلك قم بحفظ القاعدة بصيغة ( ACCDE ) واتحدا اي شخص يفتحها مرة اخرى: لكي تفتح النماذج والتقارير عليك بتخطي نموذج تسجيل الدخول ارفقت لكم قاعدة محمية وقاعدة بدون حماية مع ملف الـ VBS الذي يستخرج ارقام قطع الجهاز ويقوم بنسخها،، اتمنى لكم الفائدة جميعاً اهداء الموضوع الى مُعلمي الرائع @jjafferr حسنين Login_SEMO_Pa3x.rar

السلام عليكم ورحمة الله وبركاته الاستعلام يُعتبر العمود الفقري لقواعد البيانات ، وكلما زادت معرفتنا به ، كلما يصبح البرنامج افضل واسرع 🙂 البحث/التصفية في الاستعلام من الطرق المهمة ، ولكن وللأسف الشديد ، ارى الكثير من المبرمجين لا يعرفون الطريقة الصحيحة في عملها ، فالطريقة الغير صحيحة قد تعطيك النتائج ولكن على حساب وقت تنفيذ الاستعلام 😞 الامثله هنا تقوم على انه يوجد لدينا نموذج اسمه frm_Main ، وبه حقل الاسم fName ، وحقل التاريخ:من Date_From ، وحقل التاريخ:الى Date_To ، والحقول في الاستعلام ، حقل الاسم fName ، وحقل التاريخ DateX . 1. اذا اردنا البحث عن اسم كامل (وليس جزء من اسم) ، فيجب ان يكون المعيار في الاستعلام: [forms]![frm_Main]![fName] 2. واذا كان حقل الاسم فارغا في النموذج ، ونريد ان نرى جميع الاسماء ، فالمعيار يصبح: iif(len([forms]![frm_Main]![fName] & '')=0,[fName],[forms]![frm_Main]![fName]) والشرح للتأكد بأن الحقل فارغ في النموذج، بدل ان نكتب IsNull([forms]![frm_Main]![fName]) or [forms]![frm_Main]![fName]=0 فإننا نختصر هذين الشرطين بشرط واحد len([forms]![frm_Main]![fName] & '')=0 iif(كان الحقل فارغ في النموذج,[fName] اعطنا جميع بيانات الحقل,[forms]![frm_Main]![fName]واذا كان الحقل به قيمة فاستعمل هذه القيمة) . 3. اذا اردنا البحث عن جزء من الاسم Like IIf(Len([forms]![frm_Main]![fName] & '')=0,"*","*" & [forms]![frm_Main]![fName] & "*") والشرح IIf(Len([forms]![frm_Main]![fName] & '')=0 نعم Like "*" لا Like "*" & [forms]![frm_Main]![fName] & "*") . 4. اذا اردنا البحث بين تاريخين بدون سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) مع سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null او طريقة استاذنا واخونا العود ابو خليل Between nz([forms]![frm_main]![Date_From];"01/01/1900") And nz([forms]![frm_main]![Date_To];"01/01/2100") . جعفر

فورم بحث واضافة اكثر من عشرين عمود الى الليست بوكس وفورم اخر يظهر البيانات بالكامل الفيديو الصور تكبير الصورة معاينة الأبعاد الأصلية. تكبير الصورة معاينة الأبعاد الأصلية. هذا الفورم يفتح باثنين كليك بالماوس على الاسم تكبير الصورة معاينة الأبعاد الأصلية.

الرسم البيانى بالاكسل 3d الفيديو الصور رابط الملف http://www.mediafire.com/file/e328ajfnetadd14/3D+الرسم+البيانى.rar

أترككم مع التجربـة منتظر رأيك يا دكتور @حلبي ولى عودة بعد التجربة text Reader.mdb

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

أحسنتما بارك الله فيكم وجزاكم الله كل خير

لقد قمت بتحميل ملف كبير جداً يصعب فيه مراقبة سير المعادلات لذا وضعت لك هذا النموذج يمكن فيما بعد تكبير النطاق الى اي رقم تريد واذا اردت يمكن ان تكون التنيجة في صفحة اخرى الكود Option Explicit Sub find_missing() Dim i, k%: k = 1 Dim Rg As Range: Set Rg = Range("a1").CurrentRegion Dim coll_1 As Object Dim coll_2 As Object Dim arr1, arr2, total_arr() Set coll_1 = CreateObject("system.collections.arraylist") Set coll_2 = CreateObject("system.collections.arraylist") Range("G2:H" & Rows.Count).ClearContents With coll_1 For i = 1 To Rg.Cells.Count If Not .contains(Rg.Cells(i).Value) Then .Add Rg.Cells(i).Value End If Next .Sort arr1 = .toarray .Clear End With '========================== With coll_2 For i = 1 To Rg.Cells.Count If Not .contains(i) Then .Add i End If Next .Sort arr2 = .toarray .Clear End With Range("G2").Resize(UBound(arr1) - LBound(arr1) + 1) = _ Application.Transpose(arr1) '==================== For i = 0 To Rg.Cells.Count - 1 If IsError(Application.Match(arr2(i), arr1, 0)) Then ReDim Preserve total_arr(1 To k) total_arr(k) = arr2(i) k = k + 1 End If Next Range("H2").Resize(k - 1) = _ Application.Transpose(total_arr) Erase arr1: Erase arr2 Set coll_1 = Nothing: Set coll_2 = Nothing End Sub الملف مرفق Find_Missing .xlsm

وعليكم السلام ورحمة الله وبركاته 🙂 عملت تغيير في اسماء الحقول في النموذج ، حتى تشير الى نوع الحقل المطلوب العمل عليه ، والنتيجة: . . وهذا هو الكود في حدث فتح التقرير Private Sub Report_Open(Cancel As Integer) 'keep orignal widths in a temp place 'num If Len(Me.num.Tag & "") = 0 Then Me.num.Tag = Me.num.Width End If 'name If Len(Me![name].Tag & "") = 0 Then Me![name].Tag = Me![name].Width End If 'tel If Len(Me.tel.Tag & "") = 0 Then Me.tel.Tag = Me.tel.Width End If 'now take the required fields from Form1 'num If Forms!Form1!chk_num = -1 Then Me.num.Width = Me.num.Tag Me.num.Visible = True Else Me.num.Width = 0 Me.num.Visible = False End If 'name If Forms!Form1!chk_name = -1 Then Me![name].Width = Me![name].Tag Me![name].Visible = True Else Me![name].Width = 0 Me![name].Visible = False End If 'tel If Forms!Form1!chk_tel = -1 Then Me.tel.Width = Me.tel.Tag Me.tel.Visible = True Else Me.tel.Width = 0 Me.tel.Visible = False End If End Sub جعفر 1039.Database1.accdb.zip

هل هذا ما تطلب أم أنى أخطأت الفهم Advanced Search.rar

آمين ... ولك بمثل ما دعوت لك ولاهلك وبلدكم وبلاد المسلمين .

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

جرب هذه المعادلة الفرز النهائي لي اسماء المرضى.xlsx

السلام عليكم طريقة تنفيذ الفكرة غير عملية وطريقتك هذه تستخدم غالبا في عرض التقارير انظر المرفق تم تحقيق الفكرة للعلم يمكنك بهذه الطريقة وضع احتياطات (شرط) لمنع اخراج كمية اكبر من الرصيد وايضا تم ارفاق حل آخر مختلف ProgSalse4.rar ProgSalse5.mdb

أظن أنه من الأفضل العمل من هلال الكود Option Explicit Sub sort_by_collections() Dim obj As Object Dim i% Dim ro%: ro = Cells(Rows.Count, 2).End(3).Row Range("D3:F100").ClearContents If ro < 3 Then ro = 3 Set obj = CreateObject("System.Collections.ArrayList") With obj For i = 3 To ro If Range("b" & i) <> "" _ And Not .contains(CDate(Range("b" & i))) _ And Range("b" & i) >= Range("g2") _ And Range("b" & i) <= Range("H2") Then .Add Range("b" & i).Value End If Next .Sort Range("d3").Resize(.Count - 1).Value = _ Application.Transpose(.toarray) .Reverse Range("f3").Resize(.Count - 1).Value = _ Application.Transpose(.toarray) End With Set obj = Nothing End Sub الملف مرفق Register_salim.xlsm

تم التعديل 1-بعد اختيار (العنوان الذي تريد ) من الكومبو الاول 2- اختر من الثاتي المعيار الذي تريد 3-اضغط الزر Multi_CHOISE.xlsm

السلام عليكم ورحمة الله استخدم هذه المعادالة و لا تنسى الضغط على Ctrl+Shift+Enter =INDEX(الموقف!$B$2:$F$3;MATCH((E2&D2);الموقف!$B$2:$B$3&الموقف!$D$2:$D$3;0);5)

السلام عليكم - حياكم الله عملت استاذي المطلوب وتم العملية بنجاح - جزيت خيرا مشكور

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

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

جرب هذ الماكرو Option Explicit Sub hide_rows() Dim my_rg As Range Dim Copy_Rg As Range Dim find_Rg As Range Dim St$: St = "انتهى" Dim R%, Ro%, x% Application.ScreenUpdating = False ARCHIVE.Range("b2").CurrentRegion.Offset(1).Clear Set my_rg = Main.Range("b3").CurrentRegion.Columns(1) x = my_rg.Rows.Count Set find_Rg = my_rg.Find(St, after:=my_rg.Cells(x)) If Not find_Rg Is Nothing Then R% = find_Rg.Row: Ro = R Main.Range("b" & Ro).EntireRow.Hidden = True Do If Copy_Rg Is Nothing Then Set Copy_Rg = Main.Range("b" & Ro).Resize(, 10) Else Set Copy_Rg = Union(Copy_Rg, Main.Range("b" & Ro).Resize(, 10)) End If Set find_Rg = my_rg.FindNext(find_Rg) Ro% = find_Rg.Row Main.Range("b" & Ro).EntireRow.Hidden = True If Ro = R Then Exit Do Loop Copy_Rg.Copy ARCHIVE.Range("b2") ARCHIVE.Columns("b:k").AutoFit End If Application.ScreenUpdating = True End Sub '============================================ Sub show_all() Application.ScreenUpdating = False Main.Rows.Hidden = False Application.ScreenUpdating = True End Sub الملف مرفق hide_special_rows.xlsm

الاخ الكريم مجهود مشكور وفوق الممتاز هل يسمح باستخدامه بأي جهة وكيفية اجراء التعامل معه وكيفية تشغيل الماكرو او فك الحماية لتعديله للتفضل بالرد على الايميل ESSAMMORCE@YAHOO.COM

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

انا عملت لك الابتدائى بس يا سيدى اول حاجة لازم تعمل استعلام تجمع فيه البيانات اللى محتاجين نعملها معالجة انا هنا جمعتها مثلا فى كويرى سميته qryAllEbtdaey وبعد كده اشتغلت عليه بالدالة dcount تطلع النتيجة زى ما انت هتلاقيها فى استعلام qryCountAllEbtdaey ومن عندى عملت لك طريقة تانى لو موضوع الدالة dcount بيعمل لك صداع زى حلاتى انا عملت استعلام جدولى على الاستعلام المجمع qryAllEbtdaeyCrosstab اوفي.accdb

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

تفضل 🙂 بما انك تريد المقارنه تكون عن طريق الحقول التالية مجتمعه: [رقم المادة] و [النتيجة] و [الصفة] ، لا مو كفاية هذه الحقول ، وانما اردت هذه الحقول من جميع السجلات تكون متطابقه ، لهذا السبب ، العلاقة العادية بين الحقول في الاستعلام لم تؤدي الغرض ، ولهذا اضطررنا اللجوء للكود في الوحدة النمطية ، واذا تلاحظ ، بيانات الاستعلام qry_All هي نفسها بيانات الجدول tab_result ، ولكن الاختلاف هو في طريقة فرز الحقول ، واحدة بعد الاخرى في الاستعلام ، وذلك لتنظيم المقارنه 🙂 الوحدة النمطية المسؤوله عن العمل هي: Public Function All_Grades(ID) 'ID = رقم الطالب Dim rst As DAO.Recordset Dim RC As Integer Dim i As Integer Dim Result As String Set rst = CurrentDb.OpenRecordset("Select * From qry_All Where [رقم الطالب]=" & ID) rst.MoveLast: rst.MoveFirst: RC = rst.RecordCount For i = 1 To RC Result = Result & "_" & rst![رقم المادة] & "-" & rst![النتيجة] & "-" & rst![الصفة] rst.MoveNext Next i All_Grades = Mid(Result, 2) rst.Close: Set rst = Nothing End Function جعفر 1033.stu.accdb.zip

وعليكم السلام-تفضل مثال على المطلوب.xlsx

أستاذ يوسف عطا كل ما عملته هو أنه لاحظت كود أستاذنا الفاضل الأستاذ إبراهيم لا يعمل ووجدت السبب الذي يجعله لا يعمل فالملف الذي أرفقته في الملف التجريب به عدد 3 ماكرو أحدهم يجمع عمل كودين بحيث إذا تم تشغيل كود الدوائر يظهر كود حذف الدوائر بالتبادل و تم التعديل بإضافة الكود الذي يجعمل الكودين وكود الحذف وإليك الملف بعد التعديل تعديل أحمد.rar

تحويل اللغة تلقائيآ من العربية الى الانكليزية أو العكس بعد الخروج من مربع النص راجيآ القبول و الدعاء لي في ظهر الغيب .. تغيير اللغة تلقائيآ.accdb

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

بسم الله الرحمن الرحيم برنامج مبيعات مشتريات مخازن مجاني .. ..برنامج مبيعات و مخازن مجانى PSR لكل من يبحث عن برنامج مبيعات مشتريات مخازن مجانى لا حاجة للشراء .. هذا البرنامج يحتوى على كل ما تريد ! البرنامج صدقة جارية على روح والد المبرمج الأستاذ : أحمد فؤاد برنامج مبيعات مشتريات مخازن مجانى ارجو قبل التنزيل ان تقرأ الفاتحة ودعوة صالحة له ولوالده ولي : ) .. استعراض لخصائص ومميزات الاصدار V2018.3.4 1- تم تفعيل استخدام الباركود. 2- تم اضافة شاشة لعمل وطباعة الباركود على الاستيكرات في تبويت المخازن . 3- تم اضافة شاشة خسائر وتلفيات البضاعة . 4- تم اضافة التعديل على فاتورة المبيعات . 5- تم اضافة شاشة خصم وخسائر ديون العملاء. 6- تم اضافة تقارير البحث عن فاتورة مشتريات بالتفصيل . 7- تم اضافة تقارير البحث عن فاتورة مرتجعات لفاتورة شراء التفصيل . 8- تم اضافة تقاير الارباح والخسائر . 9- تم اضافة ميزة البحث عن تعاملات عميل اومورد بالتاريخ . 10- يتم حفظ نسخة احتياطية من البرنامج يوميا الساعة 4 مساءً اوتوماتيكيا او عند اغلاق البرنامج لأي سبب . 11- تم تسهيل التعامل مع شاشة البيع والشراء , تستطيع ادخال الكود ثم الضغط على مفتاح انتر ليوقف المؤشر على الكمية تقوم بادخال الكمية ثم اضغط انتر ليتوقف المؤشر على السعر تستطيع التعديل على السعر او اذا كنت تريد السعر كما هو تقوم بالضغط على انتر لينتقل المؤشر على زر الاضافة عند الضغط على انتر مرة أخرى يقوم البرنامج باضافة الصنف إلى الجدول. نبذة عن البرنامج على لسان المبرمج هذا البرنامج يعتبر برنامج مجانى كما ذكرت وصدقة جارية على روح والدى ليس هناك حاجة لشراءه فهو مفتوح بالكامل 1-هذا البرنامج يقوم بعمل الفواتير (مبيعات ومشتريات ومردودات المبيعات ومردودات المشتريات) كما يقوم بطباعة فواتير المبيعات ومردوادت المبيعات 2- يعتبر برنامج مخازن ايضا فهو يعرض لك الكميات المتاحة فى فواتير المبيعات والمشتريات 3-يقوم بعمل كشف حساب للعميل والمورد 4-يقوم بعمل التقارير الخاصة وطباعتها 5-يوجد به مميزات اخرى تسطيع الاستفادة منها اسم المستخدم : admin كلمة المرور : admin رابط تحميل البرنامج https://www.up-4.net/b0rcr3ihmtyy رابط تحميل قاعدة البيانات https://www.up-4.net/chzvvrdbxupk برامج مهمة للتشغيل(يجب التنصيب) 1-تنزيل حزمة netframwork 4.5 https://www.up-4.net/9dj5fjmy1f73 تنزيل برنامج اظهار التقارير CRRuntime_32bit_13_0_18 https://www.up-4.net/zq2rimykpy1m رابط تحميل شرح تسطيب البرنامج https://www.up-4.net/cc4i7ozz5pal

السلام عليكم سأشرح كيف اني أشير الى مكان وجود الجداول (سواء المضمنة او المرتبطة)، والذي سيكون مجلد الصور سيكون معه في نفس المجلد ، يعني مجلد الصور دائما يجب ان يكون في نفس مجلد قاعدة البيانات التي تحتوي على الجداول (بغض النظر ، سواء أكانت قاعدة البيانات واحدة او مقسمة). نضع هذا الكود في وحدة نمطية: Public Function GetDBPath() As String Dim strFullPath, Table_Name As String Dim rst As DAO.Recordset 'check for a linked table Set rst = CurrentDb.OpenRecordset("SELECT Name FROM msysObjects WHERE Type=6 AND Left([Name],2) Not In ('~t','ms')") If rst.EOF Then 'Table doesn't exist Exit Function Else 'linked Table exists Table_Name = rst(0) End If rst.Close Set rst = Nothing 'now get the path strFullPath = Mid(DBEngine.Workspaces(0).Databases(0).TableDefs(Table_Name).Connect, 11) GetDBPath = Left(strFullPath, InStrRev(strFullPath, "\")) End Function Public Function BE_or_FE() ' to use: ' BE_or_FE ' 'if BE exits, use its path, 'otherwise use the Application path 'get the BE Path BE_or_FE = GetDBPath If Len(BE_or_FE & "") = 0 Then BE_or_FE = Application.CurrentProject.Path End If End Function Function Images_Location() 'If we want the Backend Folder Images_Location = BE_or_FE & "\archive" 'or we can assign any location we want 'Images_Location = "c:\Temp" & "\archive" End Function وعندما اريد ان اعرف مسار الجداول (بغض النظر في كون الجداول مضمنه او مرتبطة) ، فاناديه هكذا: msgbox BE_or_FE وعندما اريد ان اعرف مسار مجلد الصور ، فاناديه هكذا: msgbox Images_Location وعندما اريد ان اشير الى الصورة التي اشرت اليها انت ، فاناديه هكذا: Images_Location & "\" & txt1 & ".jpg" جعفر

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