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

اخي الكريم طلبك موجود ضمن الكود و لست بحاجة لانشاء رسالة اخرى في حال ان الاتصال فشل سوف تظهر الرسالة ادناه VBA.MsgBox "Error " & err.Number & " (" & err.Description & ")" لكن تستطيع اضافة رسالة في حال نجاح الاتصال و لا انصح بها لأنه في كل الاحوال سيتم استخدام الكود في نموذج الواجهة الرئيسية ففي كل مرة يتم الدخول للواجعة سوف تظهر رسالة تفيد بنجاح الربط و هذا غير منطقي شكرا لك...

الاخوة الاعزاء تجدون في المرفقات فكرة في طور التطوير لعمل قوائم بأبسط الطرق و بالأدوات المتاحة آمل المزيد من اقتراحاتكم شكرا لكم ... . برنامج شئون الموظفين.rar

أحسنت أستاذ مجدى عمل رائع جعله الله في ميزان حسناتك

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

وعليكم السلام-اهلا بك في المنتدى -تفضل بلاغات.xlsm

أحسنت أستاذ أبو اَمنة عمل رائع بارك الله فيك وجعله في ميزان حسناتك

بارك الله فيك استاذ مجدى وجزاك الله كل خير

وعليكم السلام-تفضل هذا الكود Option Explicit Sub opening_multiple_file() Dim i As Integer With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True .Filters.Clear .Filters.Add "Excel Files", "*.xls*" If .Show = True Then For i = 1 To .SelectedItems.Count Workbooks.Open .SelectedItems(i) Next i End If End With End Sub

الأمر بسيط وسهل جدا عدل في الكود الى رقم الصف الذى تريده عليك بتغيير الرقم 24 الى الرقم المراد بارك الله فيك

المعادلة تعمل بكل كفاءة وتم تجربتها

فورم ترحيل بيانات عمودى وافقى الفيديو الصور

If Not IsNumeric([أسم الحقل ]) Then MsgBox "يجب ادخال ارقام في هذا الحقل", 48, "ادخـال خـاطـئ !" End if If Len([أسم الحقل]) <> 10 Then MsgBox "يجب ادخال عشرةارقام في هذا الحقل", 48, "ادخـال خـاطـئ !" End if ::بالتوفيق::

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

أحسنت استاذ مجدى بارك الله فيك وزادك الله من فضله

السلام عليكم واسعد الله ايامكم وكل عام وانتم بالف خير وددت ان اشارككم في بدء انشاء مشروعي بالاكسس حول ادارة الطلاب وقد اوضحت بالاكسل المرفق ما مطلوب من جداول وتقارير ومحددات فهل من معونة من لدن الخبراء وشكرا لكم .. k1.xlsx

DoCmd.RunSQL "DELETE data.*, InvoiceTT.InvoiceNum, InvoiceTT.ItemId, InvoiceTT.Movement " & vbCrLf & _ "FROM InvoiceTT " & vbCrLf & _ "WHERE (((InvoiceTT.InvoiceNum)=[forms]![InvoiceHT_F]![InvoiceHT_SubF].[Form]![InvoiceNum]) AND ((InvoiceTT.ItemId)=[forms]![InvoiceHT_F]![InvoiceHT_SubF].[Form]![ItemId]) AND ((InvoiceTT.Movement)=[forms]![InvoiceHT_F]![InvoiceHT_SubF].[Form]![Movement]));" DoCmd.Requery جرب هذا InvoiceSale_8.accdb

اخى الكريم تفضل لا يوجد أفضل من هذا فاتورة على الفورم 2.xlsm

على كل حال اذا كنت تريدها بواسطة الماكرو Option Explicit Sub sum_befor_date() Dim i%, x%, s#, My_date As Date Dim k%: k = 3 My_date = [CA1] Range("CA3", Range("CA2").End(4)).ClearContents x = Cells(1, Columns.Count).End(1).Column - 1 Do Until Cells(k, 3) = vbNullString For i = 3 To x Step 2 If CDate(Cells(3, i + 1)) > My_date Then Exit For s = s + Cells(3, i) Next Cells(k, "CA") = s: s = 0 k = k + 1 Loop End Sub

اخ فاضل افادنى بالحل و لكى تعم الفائده الحل هو =SUMPRODUCT(C3:BY3*(D3:BZ3<=$CA$1)*ISODD(COLUMN(C3:BY3))) شكرا استاذ سليم

السلام عليكم الحل على حسب عنوان الموضوع أخي @hassam0k New Microsoft Access Database (2).accdb افتح استعلام Q1 و انظر النتيجة

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

شكرا أستاذ @kaser906 ما شاء الله عليك رد سريع ودقيق

تفضل ::بالتوفيق:: elements906.accdb

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

اخي لدي مشروع قريب من الذي لديك قد تجد فيه ما يفيدك تفضل في المرفقات برنامج شئون الموظفين.rar

تفضل هذه فكرة اخرى إخفاء أو إظهار التقرير.accdb

وكيف سيتم التطبيق ؟

تفضل .... Lab.rar

اخي الكريم هذا كود بسيط لعملية الربط المهم ان تكون قاعدة البيانات في نفس مسار البرنامج انشئ موديل و الصق التالي مع التعديل كما هو موضح Option Compare Database Option Explicit Public Function updateTableLinks() On Error GoTo updateTableLinks_Err Dim varThis As Variant Dim strBEFileSpec1 As String dim x x=CurrentProject.Path & "\" & "اسم قاعدة البيانات"& ".mdb" ' او ضع مسار قاعدة البيانات strBEFileSpec1 = x For Each varThis In CurrentDb.TableDefs With varThis If Trim(Nz(.Connect)) Like ";DATABASE=*" Then .Connect = ";DATABASE=" & strBEFileSpec1 .RefreshLink End If End With Next varThis updateTableLinks_Exit: Exit Function updateTableLinks_Err: If Err.Number > 0 Then Resume Next Else MsgBox Err.Description Resume updateTableLinks_Exit End If End Function في حدث عند الفتح في نموذج الواجهة استدعي Call updateTableLinks

@العنكوش اخي الكريم لدي مشروعي السابق يخص الطلاب والهيئة التدريسية وحضور وانصراف الموظفينن وتسجيل غيابات الطلبة وحساب كل طال عدد محاظرات كل مادة الغائب فيها . والمقررات الدراسية وسجل درجات وتقريبا كل شيء يخص كليتنا . حجمه 11 ميكا حاولت اضغطه ببرنامج وينرار واصبح حجمه 4 ميكا ولا استطيع ارساله .... اذا هناك طريقة استطيع بها ارسال الملف لهذا المنتدى ارجو ان تخبروني بها

اريد مثل الصورة الاول بدون استعمال زر الجديد لا اريد مثل الصورة الثاني عند نقر على زر الجديد يجدد مربع النص ( باركود ) و يجدد مربع النص ( عدد ) اريد الكود لمربع النص ( باركود ) في صور الثانية بدن استعمال زر جديد

جرب هذا الماكرو Private Sub ComboBox1_Change() Application.EnableEvents = False On Error Resume Next ''''''''''''''''''''''''''''' Dim sheet_to As Worksheet Dim t$: t = ComboBox1.Value Dim My_name$ Dim My_rg As Range Select Case t Case "راسب": My_name = "رسوب" Case "ناجح": My_name = "ناجح" Case "دور ثانى": My_name = "دور ثان فى" End Select Set My_rg = Sheets("الشيت").Range("a4").CurrentRegion On Error Resume Next Sheets(My_name).Cells.Clear My_rg.AutoFilter 20, t My_rg.SpecialCells(12).Copy Sheets(My_name).Range("a4") If Sheets("الشيت").FilterMode Then Sheets("الشيت").ShowAllData: My_rg.AutoFilter End If Application.EnableEvents = True End Sub الملف مرفق Shool.xlsm

تفضل فاتورة على الفورم2.xlsm

الحمد لله على توفيقه ....

تفضل جرب المرفق .... حذف الزر جيد.rar

وعليكم السلام -تفضل التوتيق1.xlsx

بالتأكيد استاذى الكريم معادلة ممتازة جعله الله فى ميزان حسناتك

بارك الله فيك استاذ سليم عمل ممتاز

تفضل الى PDF https://convertio.co/ar/pdf-csv/ وهذا الى XLS https://convertio.co/ar/xls-csv/

بارك الله فيك وجزاك الله كل خير

لا يمكن بطريقتك هذه بل يمكن بهذه الطريقة 2التفقيط.xls

وعليكم السلام -تفضل التفقيط بالمعادلات2018 .xlsx

ممتاز استاذ ابراهيم عمل رائع جعله الله فى ميزان حسناتك

يمكنك رؤية هذا الفيديو https://www.youtube.com/watch?v=tAcC_GTZ38o

احسنت استاذنا الكبير بارك الله فيك

وعليكم السلام , اهلا بك اخى الكريم فى المنتدى عليك بوضع هذا الكود فى حدث الصفحة التى تقوم بالكتابة عليها Private Sub Worksheet_Change(ByVal Target As Range) Cells.Select Selection.Rows.AutoFit Selection.Columns.AutoFit Range("A1").Select End Sub وذلك عن طريق كليك يمين فى الأسف على اسم الصفحة ثم View Code ستفتح لك نافذة اخرى عليك لصق هذا الكود بها بارك الله فيك وموفق ان شاء الله

تفضل جلب البيانات بثلاث شروط2.rar

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

تفضل 1تقريب.xlsx

وعليكم السلام استاذى الكريم كان عليك استخدام خاصية البحث فى المنتدى تفضل https://www.officena.net/ib/topic/23984-برنامج-إدارة-العقارات-تأجير-تسديد-مصروفات-تقارير-برنامج-جاهز/?tab=comments#comment-119974 https://www.officena.net/ib/topic/25099-برنامج-عقارات-الالكتروني/?tab=comments#comment-118446 https://www.officena.net/ib/topic/22083-برامج-لمكتب-عقارات/?tab=comments#comment-102319