صالح حمادي

ما أقصده أن لا تجعله مفعل دائما نفعله عند الحاجة فقط و بإمكانك استعمال الكود الذي أخبرك به صديقي @Shivan Rekany هذا الكود لتفعيل الخاصية: Application.SetOption "Auto compact", True و هذا الكود لتعطيلها: Application.SetOption "Auto compact", False

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

السلام عليكم استخدم هذا الشكل: dim i as integer, y as integer y ' عدد السجلات For i=1 to y MsgBox DLookup("[name]", "data", "komash=" & Me.[نوع القماش]) next i

السلام عليكم من وجهة نظري و حسب تجربتي البسيطة مع هذا الخيار: فأنصحك أخي أن لا تجعل هذا الخيار دائما لأنه سوف يتسبب في تلف البرنامج و خاصة لو كان بصيغة accde

السلام عليكم هذا بسب عدم كتابة الباركود بشكل صحيح إذا استعملت مربع نص و استعملت أحد خطوط الباركود فيجب عليك إضافة * قبل و بعد الكود

هنيئا أخي @kanory تستاهل كل خير بالتوفيق و مزيدا من التألق في مشوارك البرمجي إن شاء الله

شكرا جزيلا أخي نكرر نفس الكود على حسب عدد الخطوط نضيف اسم الفولدر لهذا السطر: res = AddFontResource(CurrentProject.Path & "\fonts\DS-DIGI.ttf")

حاليا الله أعلم لم تصادفني طريقة أخرى للإخفاء

السلام عليكم تفضل هذا مثال لإخفاء النماذج لكن تستطيع إظهارها من شريط التمرير بتغيير الخصائص إخفاء الجداول و النماذج.rar

السلام عليكم: تفضل هذا الكود و معه مثال: Private Const HWND_BROADCAST = &HFFFF& Private Const WM_FONTCHANGE = &H1D Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Sub أمر0_Click() Dim res As Long ' add the font res = AddFontResource(CurrentProject.Path & "\DS-DIGI.ttf") If res > 0 Then ' alert all windows that a font was added SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, 0 MsgBox "لقد تم إضافة الخط بنجاح" End If End Sub إضافة خط للونداوز.rar

السلام عليكم استعمل الأمر me.txt1.setfocus txt1 هو اسم مربع النص الذي تريد الإنتقال إليه

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

تفضل:

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

السلام عليكم لقد جربت المرفق و هو يعمل بشكل جيد لم ألاحظ الخطأ الذي تكلمت عليه أخي ابو زاهر

شو أستاذنا شكلك راح تشتري عكاز جرب هذا المرفق أخي حربي أجريت بعض التعديلات الطفيفة ProgTime20.rar

السلام عليكم استخدم الكود التالي: Me.numx = Me.numx + 5

السلام عليكم: آسف على الإطالة لأنني مشوش قليلا و ربما سوف أغادر عالم الأكسس إلى عالم VB.NET هذا شكل الكود الجديد: On Error Resume Next Dim req As String Dim x1 As String, x2 As String, x3 As String, x4 As String Dim xkamiah As Double Dim xprix As Currency Dim xsafi As Currency Dim xkhasm As String Dim xtotal As Currency DoCmd.DeleteObject acTable, "zaher11" Dim PathImg As String Dim fpath As Variant With Application.FileDialog(3) .Title = "CIE? C?E????" .Filters.Clear .Filters.Add "txt", "*.txt" .AllowMultiSelect = False .InitialFileName = "d:\" If .Show = -1 Then PathImg = .SelectedItems(1) End If End With '----------------------------------------------------------- DoCmd.TransferText acImportDelim, (";"), "zaher11", PathImg req = "Delete From zaher11 where isnull(f1);" DoCmd.SetWarnings False DoCmd.RunSQL req DoCmd.SetWarnings True '---------------------------------------------------------------- Dim rst As DAO.Recordset Dim i As Integer, RC As Integer Set rst = CurrentDb.OpenRecordset("SELECT * FROM [zaher11]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If DCount("*", "[alsnaf]", "[id_sanf]='" & Right(rst!f1, 11) & "'") > 0 Then Me.frmSub_sra.SetFocus DoCmd.GoToRecord , , acNewRec x1 = Trim(Mid(rst!f1, 1, Len(rst!f1) - 11)) xkamiah = Right(x1, InStr(1, rst!f1, " ")) x2 = Trim(Mid(x1, 1, Len(x1) - Len(xkamiah))) xprix = Right(x2, InStr(1, x2, " ")) x3 = Trim(Mid(x2, 1, Len(x2) - Len(xprix))) xkhasm = Right(x3, 6) ') MsgBox x3 & "(" & xkhasm & ")" x4 = Trim(Mid(x3, 1, Len(x3) - Len(xkhasm))) xtotal = Right(x4, InStr(1, x4, " ")) ' ) x5 = Trim(Mid(x4, 1, Len(x4) - Len(xtotal))) xsafi = Left(rst!f1, InStr(1, rst!f1, " ")) [frmSub_sra].Form![ID_Sanf] = Right(rst!f1, 11) [frmSub_sra].Form![Sanf] = DLookup("Sanf", "[alsnaf]", "[id_sanf]='" & Right(rst!f1, 11) & "'") [frmSub_sra].Form![Alkmiah] = xkamiah 'Right(rst!f1, InStr(1, rst!f1, " ")) [frmSub_sra].Form![äÕ63] = xprix [frmSub_sra].Form![äÕ67] = Replace(xkhasm, "%", "") [frmSub_sra].Form![Asafi] = xsafi 'DLookup("Price_Sales", "[alsnaf]", "[id_sanf]='" & Right(rst!f1, 11) & "'") [frmSub_sra].Form![mjmo] = xtotal End If rst.MoveNext Next i و هذا المرفق بعد التعديل الاستاذصالح حمادي.rar

لقد وضعت لك الحل هنا مثلا لفتح الإضافة استعمل السطر الأول كما يلي: Me.AllowAdditions = True ' السماح بالإضافة

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

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

الدالة Left تقوم بأخذ جزء من سلسلة حرفية من اليسار الدالة Right تقوم بأخذ جزء من سلسلة حرفية من اليمين و هذا الرابط تجد به شرح مفصل للدالتين مع امثلة توضيحية: rst!f1 يمثل حقل الجدول الذي نستورد له البيانات من الملف النصي Left(rst!f1, 11) معناه أخذ 11 حرفا الأولى من قيمة الحقل f1 InStr(1, rst!f1, " ") هذا السطر يقوم بإستخراج مكان الفراغ بين رمز السلعة و الكمية من أجل تسجيل الكمية في حقل الكمية Right(rst!f1, InStr(1, rst!f1, " ")) هذا السطر يقوم بإستخراج الكمية المباعة. - من أجل سعر البيع استعمل السطر التالي: [frmSub_sra].Form![Asafi] = DLookup("Price_Sales", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") - من اجل سطر المجموع أضف السطر التالي: [frmSub_sra].Form![mjmo] = [frmSub_sra].Form![Asafi] * [frmSub_sra].Form![Alkmiah] ليصبح الكود بهذا الشكل: On Error Resume Next Dim req As String DoCmd.DeleteObject acTable, "zaher11" Dim PathImg As String Dim fpath As Variant With Application.FileDialog(3) .Title = "ÇÎÊÑ ÇáÊÞÑíÑ" .Filters.Clear .Filters.Add "txt", "*.txt" .AllowMultiSelect = False .InitialFileName = "d:\" If .Show = -1 Then PathImg = .SelectedItems(1) End If End With '----------------------------------------------------------- DoCmd.TransferText acImportDelim, (";"), "zaher11", PathImg req = "Delete From zaher11 where isnull(f1);" DoCmd.SetWarnings False DoCmd.RunSQL req DoCmd.SetWarnings True '---------------------------------------------------------------- Dim rst As DAO.Recordset Dim i As Integer, RC As Integer Set rst = CurrentDb.OpenRecordset("SELECT * FROM [zaher11]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If DCount("*", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") > 0 Then Me.frmSub_sra.SetFocus DoCmd.GoToRecord , , acNewRec [frmSub_sra].Form![ID_Sanf] = Left(rst!f1, 11) [frmSub_sra].Form![Sanf] = DLookup("Sanf", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") [frmSub_sra].Form![Alkmiah] = Right(rst!f1, InStr(1, rst!f1, " ")) [frmSub_sra].Form![Asafi] = DLookup("Price_Sales", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") [frmSub_sra].Form![mjmo] = [frmSub_sra].Form![Asafi] * [frmSub_sra].Form![Alkmiah] End If rst.MoveNext Next i

السلام عليكم مرحبا بك معنا أخي في منتدى أوفيسنا أولا: يجب اختيار عنوان مناسب للموضوع من أجل تسهيل المهمة للشباب لمساعدتك. (لقد قمت بتغيير العنوان) ثانيا: لقفل الإضافة و التعديل و الحذف للنموذج لاحظ الصورة التالية: للتحكم بالإضافة و الحذف و التعديل من خلال الكود استعمل ما يلي: Me.AllowAdditions = False ' منع الإضافة Me.AllowDeletions = False ' منع الحذف Me.AllowEdits = False ' منع التعديل غير False بـــ: True من أجل إتاحة التعديل و الحذف

السلام عليكم إليك طريقتين و أختار أيهما تشاء: الطريقة الأولى: Dim Strschool As String Dim i As Integer Strschool = Me.school DoCmd.GoToRecord , , acFirst For i = 1 To DCount("*", "teacher") Me.school = Strschool DoCmd.GoToRecord , , acNext Next i الطريقة الثانية: Dim mysql As String mysql = "update [teacher] set [school]='" & Me.school & "';" Me.Refresh DoCmd.RunSQL mysql الطريقة الأولى.rar الطريقة الثانية.rar

الحمد لله أخي موفق إن شاء الله