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

بارك الله فيك استاذ محمد فؤاد يمكنك استخدام هذا الكود أستاذ حسن للطباعة بدون فراغات Sub Macro4() Range("A1:e350").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="<>" Columns("A:e").Select Range("A1").Activate Selection.PrintOut Copies:=1, Preview:=True, Collate:=True On Error Resume Next Sheet2.ShowAllData On Error GoTo 0 End Sub كشف حساب.xlsm

كود للصفحة الثانية يمكنك وضع كود مماثل للثالثة Private Sub CommandButton1_Click() Feuil2.Visible = 2 Dim My_pass, Inp_box My_pass = "ABC" Inp_box = InputBox("Please Type your Password", _ "Password") If UCase(Inp_box) <> My_pass Then Exit Sub Feuil2.Visible = -1 Feuil2.Select End Sub الملف مرفق Halim.xlsm

جرب test1.xlsm

try This macro Option Explicit Private Sub Worksheet_Change(ByVal Target As Excel.Range) Application.EnableEvents = False Dim My_Address$ My_Address = Target.Offset(8, 2).Address If Not Intersect(Target, Me.Range("B2:B5")) Is Nothing _ And Target.Cells.Count = 1 Then Me.Range(My_Address) = Target.Value Sheets("close").Range(My_Address) = Target End If Application.EnableEvents = True End Sub File Inclided Walid.xlsm

بس حلك ابطأ من حللي ، لسبب : نوع الحقل في الجدول عبارة رقم ، ومعرّف انه Double ، فقمت انت في الدالة بتغيير نوعه الى Variant ، وارجعت القيم الى الاستعلام كنص (لما يكون محاذاة القيمة في الحقل ، الى اليمين ، فمعناه انه رقم او تاريخ ، بينما اذا كانت محاذاته الى اليسار فيكون نص) ، ثم رجعت في الاستعلام (او النموذج) وغيرته الى Double ، وفي حقل المجموع في النموذج استعملت الدالة NZ مرة اخرى ، والتي كذلك تحتاج الى وقت للقيام بعملها 🙂 اما طريقتي جعفر

السلام عليكم 🙂 الاكسس 2010 لم يستطع فتح المرفقات جميعا ، وحصلت على هذه الرسالة (مع ان الاكسس عندي يتم عمل له تحديث تلقائي) : . فاضطررت ان استعمل الاكسس 2019 ، واحول البرنامج الى صيغة mdb ، حتى اتعامل معاه على الاكسس 2010 !! شكرا اخوي احمد ، وبسبب ملاحظتك عن وجود حقول فارغة ، فتوصلت الى هذا الحل ، والذي يحاكي حلك ، ولكن يتفاعل مع اصل البيانات الفارغة من الاستعلام قبل ارسالها للدالة ، اما اذا ارسلت البيانات الغير كامة الى الدالة ، فستضطر ان لا تصرح عن المتغير في الدالة على انه Double 🙂 ) . والنتيجة: . جعفر 1346.price_fa.mdb.zip

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

وعليكم السلام-تفضل لك ما طلبت بالتنسيقات الشرطية بعد ضبط تنسيق التواريخ بصفحة التقويم Training Plan - Master - Final 2021.xlsx

وعليكم السلام 🙂 اذا كانت العملية الحسابية بين حقول في النموذج ، فلا داعي لإستعمال المتغير ، مثلا : if me.txt1 > me.txt2 then me.txt1= me.txt2 * 50 endif او me.txt1= me.txt1 + (me.txt2 * 50 / 5) او تاريخ بكرة me.Tomorrow= date() + 1 . بينما اذا اردت ان تحتفظ بقيمة معينه مؤقتا في الكود ، ثم تحتاج للقيمة مرة اخرى ، فالحفظ يكون في متغير ، مثلا : هذا مسار الصورة Application.currentproject.path & "\images\" & me.Project_Name & "\" & me.item_Number & ".jpg" فبدل ان استخدم هذا السطر الطويل ، وكل مرة يضطر الاكسس لقراءة قيم الحقول من النموذج if dir(Application.currentproject.path & "\images\" & me.Project_Name & "\" & me.item_Number & ".jpg")="" then me.img.picture = Application.currentproject.path & "\images\" & me.Project_Name & "\" & me.item_Number & ".jpg" else msgbox "لم يتم الحصول على الصورة في المسار التالي" & vbcrlf & _ Application.currentproject.path & "\images\" & me.Project_Name & "\" & me.item_Number & ".jpg" me.img.picture="" me.img2.picture = Application.currentproject.path & "\images\" & me.Project_Name & "\" & me.item_Number & ".jpg" end if نستطيع اعطاء المسار الى متغير ، ثم نستعمل المتغير وبما ان المسار عبارة عن نص dim myFile as string myFile = Application.currentproject.path & "\images\" & me.Project_Name & "\" & me.item_Number & ".jpg" if dir(myFile)="" then me.img.picture = myFile else msgbox "لم يتم الحصول على الصورة في المسار التالي" & vbcrlf & myFile me.img.picture="" me.img2.picture = myFile end if جعفر

تفضل الاقساط المستحقة (1).xlsm

السلام عليكم ورحمة الله وبركاته هناء : * برنامج يقوم بحساب ( تكلفة البناء ) مصمم على أوفيس 2003 * المعطيات أصحاب الشأن * أمل ان يكون عملا موفق ونافع والله من وراء القصد الشكر الجزيل لمن قدم لنا معلومة في هذا المنتدى ولمن ترك معلومة في المنتديات الأخرى واستفدنا منها Building.rar

بداية يجب إرجاع الفضل لإهله الاستاذ / سليم حاصبيا - الاستاذ ابراهيم الحداد فى مساعدتهم الدائمة وخاصة فى اعداد هذا البرنامج والذى اتمنى ان يحوز رضاكم كتلميذ من تلامذة المنتدى أمنيتى تعريفى بعيوبه من جانب اساتذتى واسم المستخدم/ محمد فتحى / وكلمة المرور 1970 ومحرر الاكواد / 6101970 1562309003_.rar

السلام عليكم اريد ضرب ( sal_fa ) * ( balance ) داخل استعلام بواسطة فاكشن price_fa.rar

في المثال المرفق تجد المبدأ للتعامل مع الزر الذي تريد إخفاؤه/إظهاره بشرط التشيك بوكس Button(1).zip

جرب اخى هذا شرح بسيط ملف.xlsx

See This Video https://www.youtube.com/watch?v=WlTFQXEAFik&ab_channel=Mycomputer

وعليكم السلام اخى هانى شوف الاستعلام الجدولى sheet_Crosstab والتقرير sheet_Crosstab لعله يفيدك ان شاء الله بالتوفيق sheet_hani(1).mdb

جزاك الله خيرا على التفسيرات الرائعه التى اعشقها لاننى اتعلم منها كل يوم 💐 بارك الله لنا فيك وبارك لك فى كل ما تحب

تفضل يا غالى كشف حساب.xlsx

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

شكرا اخى ابواشرف @عبد اللطيف سلوم على المساعده ولكن ليس هذا المطلوب المطلوب هو جمع عمود القيم الناتج عن الفنكشن اتفضل اخى @Matin_Murad تم تغيير بسيط فالفنكشن Function test(a, b) test = Nz(a, 0) * Nz(b, 0) End Function بالتوفيق اخوانى price_fa(2).accdb

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

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

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

بارك الله فيك أخي الكريم أبو عبدالله الحلوانى وفيت وكفيت أخي abouelhassan انظر داخل جدول tbl_Pages ستجد حقل ipage_ID مرقم الي رقم 11 فقط في حين ان ملف الاكسيل حقل ipage مرقم الي 65 فقم بملئ جدول tbl_Pages الي رقم 65 وأعد المحاولة وبالله التوفيق

الاستاذ حسين مامون تحياتى لشخصك الكريم مزيد من الثناء والشكر لحضرتك لما تقدمة من مساعدات وحلول اسال الله العلى العظيم ان يجزيك خيرا على ما تقدمة

جرب Copy of Copy of نموذج بيانات.xlsm

اتفضل الملف لعله يفى بالغرض ادراج صور.xlsm

جرب هذا الملف (كبداية) العمل حسب الصورة البحث حسب هذه الصورة 1-تضع ما تريد البحث عته في TextBox 2- تضغط على الــــ Option But المناسب mohamedelfoly_Form.xlsm

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

السلام عليكم ورحمة الله وبركاته بعد اذن استاذنا عصام ربيع وضعت لك كود خلف زر لاستيراد البيانات من فورم الأصناف كما بالصورة اضغط علي الزر وانظر النتيجة ولا تنسانا من دعوة بظهر الغيب ملاحظات: 1- اجعل شيت الاكسل في نفس مجلد البرنامج 2- عدل اسم العمود ipage_ID في شيت الاكسل ليتناسب مع اسم العمود بالجدول ليصبح ipage فقط 3- لا تنزعج من رسالة تأكيد الاستيراد للبيانات ImportFromExcel.rar

عودا أحمد أستاذنا عصام ربيع (طولت الغيبة علينا) مساهمة مع أستاذنا عصام جرب هذا المرفق لعله يقترب مما تريد EditData.accdb

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

مشاركة مع استاذي الفاضل @jjafferr يمكن الوصول لاذونات المستخدمين في كافة اصدارات اكسس اذا تنسيق القاعدة بصيغة mdb او mde واذا كانت القاعدة باصدار احدث من 2003 يمكن تحويلها للاصدار 2003 بشرط الا تكون تستخدم مميزات الاصدارات الاحدث من 2003 ومنها حقل نوع البيانات محسوب نوع البيانات مرفق حقول بحث متعددة القيم حقل من نوع رقم كبير وللوصول الى الاذونات في الاصدارات الحديثة بعد تحويل الملف نفتحة فتح خاص ثم معلومات

تم تقليل الحجم حجمه العادي 2.9 ميجا حجمه المضغوط 0.9 ميجا قمت بتحويل بعض المعادلات العادية الي معادلات صفيف وحمايتها من العبث file1.rar

هذا أمر طبيعى لكثرة المعادلات وكثرة الصفحات بالملف !! على الرغم من كل هذا فتم تقليل مساحة البرنامج كثيراً فأصبح الأن 3.26 ميجا file.rar

طيب جرب الكود ده Function AppShortcut() Dim StrDisplayName As String Dim StrDescription As String Dim StrIconPath As String Dim DesktopPath As String Dim StrHotkey As String Dim Shell As Object Dim link As Object 'StrDisplayName = CurrentProject.Name 'StrDescription = "Official Sponsor: www.officena.net" StrDisplayName = ChrW(1575) & ChrW(1587) & ChrW(1605) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1576) & ChrW(1585) & ChrW(1606) & ChrW(1575) & ChrW(1605) & ChrW(1580) StrDescription = ChrW(1608) & ChrW(1589) & ChrW(1601) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1576) & ChrW(1585) & ChrW(1606) & ChrW(1575) & ChrW(1605) & ChrW(1580) Set Shell = CreateObject("WScript.Shell") DesktopPath = Shell.SpecialFolders("Desktop") Set link = Shell.CreateShortcut(DesktopPath & "\" & StrDisplayName & ".lnk") StrHotkey = "F7" link.Description = StrDescription link.TargetPath = CurrentDb.Name If Dir(CurrentProject.Path & "\Icon\" & "Myicon.ico") <> "" Then link.IconLocation = CurrentProject.Path & "\Icon\" & "Myicon.ico, 0" Else link.IconLocation = SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE, 0" End If link.Hotkey = StrHotkey link.WindowStyle = 3 link.Save End Function وطبعا نستدعى الكود كالاتى Private Sub Form_Load() Call AppShortcut End Sub

أستاذ / محمود الشريف بارك الله فيك شرح رائع جداً جداً جداً جداً جعله الله في ميزان حسناتك ونفع بك الإسلام والمسلمين

السلام عليكم ورحمة الله أخي الكريم، أقدم لك حلين بالمعادلات في الملف المرفق... أخوك بن علية proge_1.rar

السلام عليكم هل ترغب في استيرادها بزر في الملف 2 اذا اردتها عند فتح الملف 2 استخدم الكود التالي في حدث ThisWorkbook Private Sub Workbook_Open() Call kh_DateImport End Sub وهذا هو الكود : Sub kh_DateImport() Dim ib As Boolean Dim MyAr Dim MySh As Worksheet Dim MyNBook As String, MyPath As String, rAd As String On Error GoTo 1 Set MySh = ThisWorkbook.Sheets("Statment") MySh.UsedRange.ClearContents MyNBook = "ملف 1" & ".xls" MyPath = ActiveWorkbook.Path & "\" & MyNBook '--------------------------------------- ' هل الملف مغلق ib = Not Workbook_Open(MyNBook) '--------------------------------------- Application.ScreenUpdating = False ' اذا الملف مغلق يقوم بفتحه If ib Then Workbooks.Open MyPath '--------------------------------------- With Workbooks(MyNBook).Sheets("Statment") rAd = .Cells.CurrentRegion.Address MyAr = .Range(rAd).Value End With '--------------------------------------- ' اذا كان الملف مغلق سابقا يقوم باغلاقه If ib Then Windows(MyNBook).Close '--------------------------------------- MySh.Range(rAd).Value = MyAr Application.ScreenUpdating = True MsgBox "تم الاستيراد بنجاح" 1: If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear End If MyAr = Empty Set MySh = Nothing End Sub 'دالة لمعرفة ان كان الملف مفتوخ Function Workbook_Open(WbookName As String) As Boolean Dim wBookCheck As Workbook Application.Volatile On Error Resume Next Set wBookCheck = Workbooks(WbookName) Workbook_Open = Not wBookCheck Is Nothing On Error GoTo 0 End Function شاهد المرفق Data1-2.rar