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

تفضل التعديل ارجو ان يكون طلبك ترقيم تلقائى-3.rar

اخوانى السلام عليكم اريد المساعدة فى تجميع وحدات صنف لمحل بيع اسمنت المحل يشترى الاسمنت بالطن ثم يبيع بالطن او بالشيكارة ( الطن 20 شيكارة ) مثلا اشترى 10 طن اسمنت ثم باع 3 طن فى فاتورة وباع 4 شكاير فى فاتورة اخرى اريد تجميع الباقى ليكون لدى 6 طن و16 شيكارة اسمنت.mdb

تتهافت الحروف بكلماتها لتجسد لكم أجمل عبارات الشكر والثناء بس لو تكرمت حضرتك ممكن افهم كيف تم فعل ذلك اتمنا شرح الكود لو تكرمت

السلام عليكم مشاركه مع اخى @ناقل جزاه الله خيرا هل هذا ما تريد جرب ووافنا بالنتيجه If Me.Combo1 Like "<select ALL >" Then Me.data.Form.RecordSource = "SELECT data1.* FROM data1;" Else Me.data.Form.RecordSource = "SELECT data1.* FROM Data1 " & _ " WHERE (((data1.LINE)=[Forms]![Search]![Combo1]));" End If بالتوفيق mm.accdb

السلام عليكم اتفضل ان شاء الله يكون ما تريد وهذا الحل الذلا اشار به لك اخى @ناقل جزاه الله خيرا بالتوفيق المحل - Copyjhgj.rar

رد واحد والله يكفى

جرب هذا الماكرو Option Explicit Sub Tarheel() Dim Mon_ARray(4) Dim ro%, X_C%, X_H%, Dr% Dim D As Worksheet, P As Worksheet Set P = Sheets("Permession") Set D = Sheets("Data") With P Mon_ARray(0) = .[G7]: Mon_ARray(1) = .[C4] Mon_ARray(2) = .[C8]: Mon_ARray(3) = .[H8] Mon_ARray(4) = .[C9] End With With D Dr = Application.Max(.Range("a:a")) + 1 ro = .Range("A3").CurrentRegion _ .Columns(1).Rows.Count + 3 .Cells(ro, 1) = Dr .Cells(ro, 1).Resize(, 11).Interior.ColorIndex = 35 .Cells(ro, 2).Resize(, UBound(Mon_ARray) + 1) = _ Mon_ARray Erase Mon_ARray End With X_C = Application.CountA(P.Range("C12:C18")) X_H = Application.CountA(P.Range("H12:H18")) D.Cells(ro, "H").Resize(X_C, 2).Value = _ P.Range("B12").Resize(X_C, 2).Value D.Cells(ro, "J").Resize(X_H, 2).Value = _ P.Range("G12").Resize(X_H, 2).Value End Sub الملف مرفق rouk.xlsm

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

اتفضل الملف لعله يفى بالغرض ولكن النص والارقام مرتبطه مع بعضهما نسخة من نص معكوس.xlsm

شرخ فكرة الجماية 1- اغلاق قاعدة الجداول و القاعدة الامامية بكلمة مرور ويتم كالاتى فتح تطبيق الاكسس نفسه من من قائمة ابدا نختار فتح نحدد قاعدة البيانات المراد اضافة كلمة مرور لها ملاحظة هامة لا بد من فتحها حضريا من حلال الضغط على السهم الصغير لتخرج تلك القائمة كما فى الصورة ونختار منها الفتح حصريا ومن قائمة ملف نختار رمز اضافة كلمة المرور وفى هذه الشاشة نكتب كلمة المرور ثم نعيد كتابتها مرة اخرى للتأكيد تلك الخطوات يتم عملها لكل من القاعدتين الامامية والخلفية ان كنت قسمت قاعدة البيانات الان ملاحظتان مهمتان جدا جدا جدا - عند كتابة كلمة مرور لابد ان تحتوى على حروف صغيرة + حروف كبيرة + ارقام + رموز مثال 135MoHa(^_*)MmEd246 2- لحماية الكائنات والنماذج وعدم الاطلاع على تصميم القاعدة يتم اخفاء اطار الاكسس نهائيا 3- فى حال تقسيم قاعدة البيانات طبعا يتم وضع اكواد الربط بين القاعدة الامامية والخلفية برمجيا الان قاعدة بيانات تشغيل التطبيق وهى محور الموضوع هى قاعدة وسيطه فقط تمرر كلمة المرور برمجيا للقاعدة الاساسية ليتم فتحها دون المطالبة بكلمة مرور من خلال الكود الاتى الذى يتم وضعه داخل نموذج ويتم فتح النموذج تلقائيا عند فتح القاعدة اما من خلال الاعدادت او ماكرو autoexec طبعا يتم تحويل القاعدة الى Accde وذلك حتى لا يطلع احد على هذه الاكواد ويستطيع معرفة كلمة مرور فتح القاعدة وبذلك 1- المبرمج فى اى وقت له القدرة على فتح القواعد لاجراء اى تعديلات او تحديثات هو فقط يعرف كلمة المرور 2- لا يستطيع احد الوصول الى بيانات داخل الجداول وبذلك تم تأمين بيانات العميل اصلا 3- لا يستطيع احد الوصول الى التصميمات بطرق غير مشروعة ملاحظة قمت بكسر حماية قاعدة mdb بمعرفة كلمة المرور ولم استطع ذلك مع accdb ومن اجل ذلك انصح باعتماد قواعد البيانات بتنسيق accdb Option Compare Database Option Explicit Const strPasswordDB = "كلمة المرور" Private Sub Form_Load() On Error GoTo Err_BtnRunMyDB_Click Dim strPathTablesDB As String Dim strPathAppDB As String Dim strPasswordDB As String Dim accessApp As Access.Application Dim db As DAO.Database Dim MsgTitl As String Dim MsgErorTbl As String Dim MsgErorErorApp As String Dim MsgErorTblAndApp As String Dim MsgCallDesign As String MsgTitl = "تنبيه" MsgErorTbl = "تم فقدان قاعدة بيانات الجداول او تم التلاعب باسم القاعدة" MsgErorErorApp = "تم فقدان قاعدة بيانات التطبيق او تم التلاعب باسم القاعدة" MsgErorTblAndApp = "تم فقدان قاعدة بيانات الجداول او قاعدة التطبيق او تم التلاعب باسم القواعد" MsgCallDesign = "يرجى الإتصال بمصمم التطبيق" strPathTablesDB = Application.CurrentProject.Path & "\TablesArchivingDB.accdb" ' <<----< مسار قاعدة الجداول strPathAppDB = Application.CurrentProject.Path & "\Archiving.accdb" ' <<----< مسار القاعدة الامامية If FileExist(strPathTablesDB) Or FileExist(strPathAppDB) Then If FileExist(strPathAppDB) Then Dim MyDb As Database Set MyDb = OpenDatabase(strPathAppDB, False, False, ";PWD=" & strPasswordDB) Call ChangeProperty("AllowBypassKey", dbBoolean, False, MyDb) If FileExist(strPathTablesDB) Then Set accessApp = New Access.Application With accessApp .Visible = True .UserControl = True .RunCommand acCmdAppMaximize DoCmd.RunCommand acCmdAppMaximize Set db = .DBEngine.OpenDatabase(strPathAppDB, False, False, ";PWD=" & strPasswordDB) .OpenCurrentDatabase strPathAppDB End With db.Close Set db = Nothing Set accessApp = Nothing Application.Quit Else MsgBox MsgErorTbl & Chr(13) & Chr(10) & MsgCallDesign, vbMsgBoxRtlReading + vbMsgBoxRight + vbOKOnly, MsgTitl Exit Sub End If Else MsgBox MsgErorErorApp & Chr(13) & Chr(10) & MsgCallDesign, vbMsgBoxRtlReading + vbMsgBoxRight + vbOKOnly, MsgTitl Exit Sub End If Else MsgBox MsgErorTblAndApp & Chr(13) & Chr(10) & MsgCallDesign, vbMsgBoxRtlReading + vbMsgBoxRight + vbOKOnly, MsgTitl Exit Sub End If Exit_BtnRunMyDB_Click: Exit Sub Err_BtnRunMyDB_Click: MsgBox Err.Description Resume Exit_BtnRunMyDB_Click Exit Sub End Sub Public Function FileExist(strPath) As Boolean If Dir(strPath) <> Empty Then FileExist = True Else: FileExist = False End Function Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant, dbs As Database) As Integer Dim prp As Property Const conPropNotFoundError = 3270 On Error GoTo Change_Err dbs.Properties(strPropName) = varPropValue ChangeProperty = True Change_Bye: Exit Function Change_Err: If Err = conPropNotFoundError Then Set prp = dbs.CreateProperty(strPropName, _ varPropType, varPropValue) dbs.Properties.Append prp Resume Next Else ChangeProperty = False Resume Change_Bye End If End Function

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

Connect To Network (2003).mdb

اتفضل البحث فى القران الكريم.zip

بارك الله فيك استاذ سليم وبعد اذن حضرتك ولإثراء الموضوع -يمكن أيضاً استخدام هذه المعادلة بداية من الخلية N3 سحباً يساراً وأسفل =COUNTIFS($H$3:$H$500,"<="&$M3,$H$3:$H$500,">="&$L3,$I$3:$I$500,N$2) Countifs,معادلة احصاء عدد الذكور والإناث بين تاريخين.xlsx

في الخلية (N3) هذه المعادلة واسجب عامودين و 7 أعمدة =SUMPRODUCT(--($H$3:$H$53<>""),--($H$3:$H$53<=$M3),--($H$3:$H$53>=$L3),--($I$3:$I$53=N$2)) الملف مرفق Mustafa.xlsx

جرب هذا الملف 1- دبناميكي اي انه بضيف اسم الشيت المستجدثة او توماتيكياً الى القائمة المنتسدلة (الخلية الصفراء) (في حال اضافة شيت جديد) 2-قم بتسمية الأوراق حسب اسم الطالب الذي تحتويه كما في الصورة المرفقة 3- تم التعديل على المعادلات كي لا يكون هناك أخظاء قي حال كتابة قيمة ليست رقماً في اي خلية (الصورة) 4- كان يجب تعبئة الجداول ولا تترك هذا الشيء لمن يريد ان يساعدك 5- اختر من القائمة المنسدلة اسم الشيت ثم اضغط على الزر Run 6- الملف مرفق sohail.xlsm

تفضل لك ما طلبت ... وذلك لوجود مسافات زائدة بالمعادلة , تم حذفها ,ورجاءاً لابد ان تكون نهايات فورمات الملف XLSX وليس XLS محمد4.xlsx

تفضل هذه المحاولة وارجو ان تكون طلبك ترقيم تلقائى-2.rar

ادخل على خصائص الكمبو وعدل عدد الاعمدة من 2 الى 1 انظر الصور

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

1-ليس من الضرورة رفع ملف يجتوي على اكثر من 1500 صف لان الماكرو الذي يعمل على صف واحد بستطيع العمل على الوف الصفوف 2- تم اختصار الملف الى حوالي 80 صف لمتابعة عمل الماكرو 3-الكود Option Explicit Dim sh As Worksheet Dim New_sh As Worksheet Dim lr%, Cont#, i%, x%, k% Dim SectionName As Range Const How_Many = 20 '+++++++++++++++++++++++++++++++ Sub Del_sheets() Application.DisplayAlerts = False For Each sh In Sheets If sh.Name Like "Section*" Then sh.Delete End If Next Main.Select Application.DisplayAlerts = True End Sub '++++++++++++++++++++++++++++++ Sub insert_Sheets() Del_sheets Set SectionName = Main.Range("D3:K3") lr = Main.Cells(Rows.Count, 3).End(3).Row Cont = (lr - 1) / How_Many If Int(Cont) <> Cont Then Cont = Cont + 1 End If Cont = Int(Cont) For i = 1 To Cont Sheets.Add(, Sheets(Sheets.Count)).Name = "Section_" & k * How_Many + 1 k = k + 1 SectionName.Copy With ActiveSheet.Range("D3") .PasteSpecial (xlPasteAll) .PasteSpecial (8) End With Next Application.CutCopyMode = False Main.Select End Sub '++++++++++++++++++++++++++++++++++++ Sub fil_data() Application.ScreenUpdating = False insert_Sheets x = 4 For Each New_sh In Sheets If New_sh.Name Like "Section*" Then Main.Range("D" & x).Resize(How_Many, 9).Copy New_sh.Range("D4").PasteSpecial (xlPasteAll) New_sh.Range("D4").PasteSpecial (8) x = x + How_Many End If Next Application.ScreenUpdating = True Main.Select End Sub 4-الملف مرفق Taksim_Ahmad.xlsm

تفضل هذه المحاولة اسمنت-1.rar

لنلق نظرة على مثال بسيط جدًا لإنشاء Class Alt+F11 Insert Module Class Module يظهر لنا محرر Visual Basic قبل البدء بكتابة الكود يفضل ان نثبت إسم للوحدة النمطية و ليكن clsCustomer في المحرر نكتب ' Class name: clsCustomer Public Name As String قم بحفظ الاجراءات و اخرج من الوحدة النمطية و لنقم مثلاً بانشاء نموذج جديد و نفتح عرض التصميم ، و في محرر Visual Basic نضع الروتين التالي Private Sub sfPrint() End Sub حيث نقوم بتعريف اسم زيون جديد حسب المعرف في clsCustomer باستخدام العبارة ، و هي اساسية لتعريف الزبون الجديد Dim oCustomer As New clsCustomer ثم نستخدم خاصية الاسم name. لهذا الزبون الجديد و نسند له القيمة ' Set the customer name oCustomer.Name = "Nart Lebzo" ثم نحدد الاجراء المراد تطبيقه ' MsgBox the name MsgBox oCustomer.Name و بذلك يصبح الكود كما يلي Private Sub sfPrint() ' Create the object from the class module Dim oCustomer As New clsCustomer ' Set the customer name oCustomer.Name = "Nart Lebzo" ' MsgBox the name MsgBox oCustomer.Name End Sub ثم نقوم ( مثلا ) بانشاء زر أمر نضع خلف حدث النقر الكود التالي لاستدعاء الروتين الذي يطبق clsCustomer Private Sub Command0_Click() Call sfPrint End Sub و للحديث بقية ......

يتم تعريف كل كائن في Visual Basic بواسطة Class و الذي يحوي و يفصل المتغيرات والخصائص والإجراءات والأحداث الخاصة بالكائن ، و تصبح هذه الكائنات ممثلة ل Class ؛ و بذلك يمكنك إنشاء العديد من الكائنات التي تحتاج إليها بمجرد تعريف و إنشاء Class. Class ، تحدد و تعرف الصفات المميزة للكائنات الخاصة بنا . و للتعامل مع الكائن و مميزاته و اجزائه ، لا بد من إنشائه بموجب Class و هنا نستخدم Class لإنشاء تعريف لكائن مخصص . يصبح الاسم الذي قمت بحفظ Class به هو اسم الكائن المخصص الخاص بك. تصبح الإجراءات Sub Sub و Function التي تحددها داخل Class أساليب مخصصة للكائن. تصبح إجراءات الملكية العامة Let و Property Get و Set Property خصائص الكائن. و للحديث بقية ....

اخوتي الفضلاء في اللغات البرمجية مثل # C و Java ، يتم استخدام Class لإنشاء الكائنات ، و لها مرادف في VBA في Access ، هناك نوعان من الوحدات النمطية : الوحدات النمطية القياسية والوحدات النمطية للفئة Standard modules and class modules موضوع حديثنا هنا والوحدات النمطية للفئة Class ، و هي مصنع الكائنات و خصائصها ، لذا لا بد لنا ان نعرج قليلا على أهم مفاهيم الكائنات في Visual Basic . الكائن هو مزيج من الكودات و البيانات التي يمكن التعامل معها كوحدة واحدة ، و يمكن أن يكون الكائن جزءًا من التطبيق ، مثل عنصر تحكم أو نموذج ، ويمكن أن يكون التطبيق بأكمله كائنًا . عند إنشاء تطبيق في Visual Basic ، تعمل باستمرار مع الكائنات ، و الغالب فيها هي الكائنات التي يوفرها Visual Basic ، مثل عناصر التحكم والنماذج وكائنات الوصول إلى البيانات. Dim db As DAO.Database Dim qd As QueryDef Dim ctl As Control Dim pag As Page كما يمكنك أيضًا استخدام الكائنات من التطبيقات الأخرى داخل تطبيق Visual Basic. Dim ExcelSheet As Object Set ExcelSheet = CreateObject("Excel.Sheet") و الذي يهمنا هنا انه يمكنك أيضًا إنشاء كائناتك الخاصة وتحديد خصائصها و طرق عملها ، و تكون هذه الكائنات مثل اللبنات الجاهزة للبرامج - فهي تتيح لك كتابة الكود مرة واحدة وإعادة استخدامها مرارًا وتكرارًا عند الحاجة لها . و كأي شيئ آخر هناك حسنات و معيقات لاستخدام الكائنات الخاصة في التطبيقات ، ومن الحسنات ، إتاحة بناء التطبيق ككتل معتمدة على الكائنات التي يتم انشاؤها ، ويكون من السهل فحص و اختبار أجزاء التطبيق ، و اذا اضطررنا ( كما يحدث غالبا ) لتعديل او تحديث الكود ، تجنبنا حدوث مشكلات في أجزاء أخرى من التطبيق ، و يبقى دائما من السهل إضافة كائنات بين التطبيقات . أما المعيقات فتتمثل في الجهد والوقت الأطول ( في البداية ) لإنشاء التطبيقات و خاصة عند التحليل و التخطيط ، ولكن على المدى الطويل سيكون هناك توفير للوقت بالاضافة الى كودات يسهل التعامل معها و تحديثها و تعديلها ، كما أنه ليس من السهل دائمًا تحديد ماهية الكائن و خصائصه ، كما أن معظم المبرمجين ( و خاصة الجدد منهم ) يجدون صعوبة ( في البداية ) بفهم الكائنات و الوحدات النمطية للفئة Class . وللحديث بقية ...

وهذا ايضا في خصائص الازرار وهنا موضوع بها تلك الازرار اللي في الصورة الاعلاه

وهذا شرح بالصور لما قاله اخي شفان ، للأكسس 2010 عليك عمل زر امر ، ويكون عليه الاختيار ، ثم . ثم . . . . وهناك نماذج مختلفة . ونماذج بأزرار خاصه . وهذه لتغيير نمط النموذج ، بخطوط والوان ووو . جعفر

الفرق بين ByVal و ByRef Byval يقصد بها الاستدعاء بالقيمة ByRef يقصد بها الاستدعاء بالمرجع الكود التالي سيوضح الفكرة أكثر لنفرض لدينا عددين و نريد تطبيق كود معين او معادلة ما على هذين العددين 'نضع هذا الكود خلف زر امر في نموذج dim x as intger dim y as intger dim i as intger x=10 y=5 'استدعاء كود الجمع بالقيمة و اظهار الناتج i=add1(x,y) msgbox i msgbox x 'استدعاء كود الجمع بالمرجع و اظهار الناتج i=add2(x,y) msgbox i msgbox x 'كود الجمع باستخدام Byval private function add1(byval n1, byval n2) as intger add1=n1+n2 n1=3 end function 'كود الجمع باستخدام ByRef private function add2(byref n1, byref n2) as intger add2=n1+n2 n1=3 end function الشرح في المثال انشئت وظيفة بسيطة لجمع عددين هما X Y عرفت متغيرين و وضعت قيم فيها وهي (x=10) و (y=5) الوظيفة Add1 انشئت وظيفة اسمها Add1 تستقبل عددين هما n1 و n2 ( بالقيمة ) Byval تقوم الوظيفة بجمع العددين و ارجاع الناتج ( و هنا الناتج 15 ) من خلال هذا السطر add1=n1+n2 ثم غيرت قيمة العدد الاول من 10 الى 3 من خلال هذا الكود n1=3 هذا يعني ان x يجب ان تصبح قيمتها 3 ولكن ستجد ان قيمة X مازالت 10 !!!!!!!!!!!!!!!! ( لاحظ انه بعد تعديل قيمة X من الوظيفة وضعت رسالة لتعطي قيمة x ) الوظيفة Add2 الوظيفة Add2 في نفس الوظيفة Add1 لكن الفرق ان الوظيفة Add2 تستقبل القيم n1 و n2 ( بالمرجع ) ByRef تقوم الوظيفة بجمع العددين و ارجاع الناتج ثم غيرت قيمة العدد الاول من 10 الى 3 ولكن هنا ستجد ان قيمة X اصبحت 3 !!!!!!!!!!!!!!!! السبب ان Byval تحافظ على القيمة الاصلية للمتغير المرسل لها اما Byref فهي تغير القيم للمتغير المرسل لها ارجو ان اكون قد وفقت في الشرح

السلام عليكم الشكر واصل للاخ حسام عيسى ....حفظه الله الكود موجود في موديل الورقة Search Private Sub Worksheet_Change(ByVal Target As Range) If Not Target.Address = Range("C2").Address Then Exit Sub '''''''''''''''''' Dim Lr As Long, i As Long, R As Long Dim txt Range("A6:F25").ClearContents txt = Trim(Target) If Len(txt) < 3 Then Exit Sub With Sheets("Data") Lr = .Cells(.Rows.Count, "A").End(xlUp).Row For i = Lr To 2 Step -1 If txt = CStr(.Cells(i, "A")) Or txt = CStr(.Cells(i, "B")) Or InStr(CStr(.Cells(i, "C")), txt) Then Cells(R + 6, "A").Resize(1, 3).Value = .Cells(i, "A").Resize(1, 3).Value Cells(R + 6, "D").Resize(1, 2).Value = .Cells(i, "E").Resize(1, 2).Value Cells(R + 6, "F").Value = .Cells(i, "H").Value R = R + 1 If R = 20 Then Exit For End If Next End With End Sub المرفق 2010 Search++.rar تحياتي

أول مرفق في موضوعك .... هل حدثت مرفقات اخرى