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

تم عمل المطلوب بطريقة بدائية جرب المرفق ووافني بملاحظاتك حساب المدير : اليوزر = a الباسوورد = 1 حساب المستخدم : اليوزر = b الباسوورد = 2 ملاحظة في محلها .. ولا اخفيك اني قرأت ملاحظتك بعد ان ادرجت الكود ، والآن الكود معطل اذا اردت يا اباحسان تفعيل اخفاء الاطارات افتح نموذج frmlogin على التصميم واذهب الى حدث تحميل النموذج تجد الدالة المسؤولة HideAccess' معطلة ، كل ما عليك فعله ان اردتها تعمل هو ان تزيل علامة التنصيص الصغيرة الموجودة يسار الدالة . ومؤكد ستفاجأ بعد تفعيلها انه لا يمكنك الدخول الى طار قاعدة البيانات ولن ترى الكائنات .. ما الحل ؟ الحل هو ان تضغط على زر الشيفت بيدك اليسرى وتستمر ضاغطا بينما يدك اليمنى تقوم بتشغيل قاعدة البيانات .. ستلاحظ ان قاعدة البيانات فتحت على التصميم هنا اذهب الى الدالة المذكورة وعطلها ان احببت Data3.rar

اخبرني احد الأخوة أن المرفق لا يعمل ويبدو وكانه فيرس سأقوم بتحميل المرفق بصيغة accdb أشكر أخوتي أ/ @kanory و أ/ @abouelhassan علي مروهم الكريم وكلماتهم الطيبات ولا انسا تقديم الشكر للأستاذ أحمد عبدالمنعم صاحب هذا الفيديو فقد كان من المصادر الهامة أيضا هذا MenuAndShortCutMenu.accdb

ولا توجد كلمات عربيه في الكود هنا كذلك 🙂 النموذج: . والنتيجة: . جعفر 1337.Arabic تفقيط.mdb.zip

وعليكم السلام 🙂 ولو اننا بحاجة الى معرفة طريقة ارسال البيانات الى هذه الدالة ، ولكن جرب : Function m_ar(a As integer) As String If a < 20 Then m_ar = "عربي" Else m_ar = "" End If End Function جعفر

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

لم ارد عليك ، لأني بدأت أقرأ زيادة من ذلك لوقت (وطلعت من البيت حبتين ، وتغديث ، واخذت غفوة ، وواصلت القراءة 🙂 ) ، اعطيك رابطين من المواقع الاجنبية: الاول مجمع جميع الاقتراحات : Access - Bug - Database is in an Unrecognized Format | DEVelopers HUT (devhut.net) والثاني الاخذ والعطاء فيه لايزال مستمر من حوالي سنتين حول هذه النقطة وما حولها : Access Database is getting corrupt again and again - Microsoft Community الله يعينك ، ورجاء تخبرنا وين توصل 🙂 جعفر

هذا هو المرفق أرجو أن ينفع الله به أحدا من المسلمين المرفق يحتاج اضافة مرجع كما بالصورة المراجع والمصادر: 1- من شركة مايكروسوفت 2- لمزيد من الشرح والتوضيح من معلمنا أ/ جعفر MenuAndShortCutMenu.rar InsertReference.rar

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

بالتوفيق اخي الكريم تحياتي

جرب هذا إذا ووافنا بالنتائج مثال 4.accdb

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Data3.rar تحياتي

جزاك الله خيرا علي تلك الدعوات الطيبات ولك بالمثل ان شاء الله

بسم الله ماشاء الله ربنا ييارك فيك وفى اولادك الى يوم الدين ويرزقك برهم فى الدنيا والاخره ويقر عينك بهم هو المطلوب بالفعل بعد طول انتظار ولكن اثمرت النتائج بالخير بارك الله فيك ياغالى

بس ولا تعصب علينا جرب هذا ووافنا بالنتائج ولا تنسنا من دعائك مثال 4.accdb

ايضا جرب طريقة ناجحة في الغالب خاصة اذا كان الخلل في جداول النظام ، وهي نقل جداولك الى قاعدة جديدة

هل من الممكن أن يتم عمل تلك القائمة اتوماتيك وليس بزر أمر (تم عمل ذلك اذا لم تظهر ثائمة الاسماء غادر الصفحة ثم عد اليها) 1- عودة الصف رقم 6 للعمل داخل الصفحة(DATA) لضرورة انشاء جدول للفلتر 2-الضفحة تدرج مباشر ة بعد الشيت DATA 3- هذا الماكرو يدرج صفحة باسم كل عميل مع بياناته بشكل مستقل ( الزر Sheet For Every one) 4-اذا زاد عدد العملاء الكود يتصرف بهذا الأمر Option Explicit Sub ADD_Sheet() Dim D As Worksheet Dim m%, i%, Rod, RoH% Dim Ft_rg As Range, Crit$ Dim Ar_sh(), itm Set D = Sheets("DATA") Set Ft_rg = D.Range("a5").CurrentRegion Rod = D.Cells(Rows.Count, 1).End(3).Row RoH = D.Cells(Rows.Count, "H").End(3).Row With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With If Rod < 6 Or D.Cells(6, "H") = vbNullString Then GoTo Bay_Bay_Ya_Helween End If For i = RoH To 6 Step -1 If Not Application.Evaluate("ISREF('" & _ D.Range("H" & i) & "'!A1)") Then Sheets.Add(, after:=Sheets("DATA")).Name = _ D.Range("H" & i) End If Next D.AutoFilterMode = 0 For i = 1 To Sheets.Count If Sheets(i).Name = "print" Or Sheets(i).Name = "DATA" Then Else ReDim Preserve Ar_sh(m) Ar_sh(m) = Sheets(i).Name m = m + 1 End If Next For Each itm In Ar_sh Sheets(itm).Range("A6").CurrentRegion.Clear Ft_rg.AutoFilter 1, itm Ft_rg.SpecialCells(12).Copy Sheets(itm).Range("A6").PasteSpecial (8) Sheets(itm).Range("A6").PasteSpecial Sheets(itm).Range("H6") = "Account Of" & Space(3) & itm _ Next itm D.Select D.AutoFilterMode = 0 Bay_Bay_Ya_Helween: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub Issa_Macro_New.xlsm

حقيقة لا أذكر كيف تم حل المشكلة لدي عند وقوعي بهذه المشكلة من قبل ولعله بعد تحديث نسخة الوندوز الي ويندوز 10 أو تحديث نسخة الأوفس الي أوفيس 16 ربما ولكن لا أذكر تحديدا ما حدث بالضبط ولكن لعل هذه المشكلة تنذرك بكبر حجم قاعدة البيانات لديك وأنها لم تعد تستطيع الصمود لاكمال المسيرة الي النهاية أو هنالك مشكلة أكبر قد تحدث بعد لذي جئت ناصحا بـ: 1- أخذ نسخة احتياطية بشكل يومي الي حين الوصول الي حل ان شاء الله 2- حاول تكبير قاعدة البيانات (أقصد التعامل مع الـ SQL server) حقيقة ستجد به متسع من الأمان وسعة التخزين وبعدا عن مشكلات الأكسس كهذه التي بين يديك. أعرف أن الاقتراح الثاني ليس سهلا للغاية ولكنه لا يصعب علي أبي جودي تمنياتي بالتوفيق وحل المشكلة بأجل قريب ان شاء الله.

اقتراحات حديثة جدا ربما تساعد في العرف على المشكلة و الحلول لها الموقع

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

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

عندي كل شيء على ما يرام (الصورة توضح ذلك) لتغيير عامود الجمع استبدل Bx بــــــ BN (الصورة الثاتية)

جرب هذا لعله يوافق مرادك اذن صرف ادوات نظافة.rar

وعليكم السلام ورحمة الله وبركاته الحفظ في D يمكنك تغيره في الكود backup.xlsm

جرب هذا الملف Mohamed D.xlsx

اما الكود فيمكنك اختصاره كالتالي: If DCount("*", "qry_tbl2", "HNO =" & Me.tn) = 0 Then MsgBox "الرقم غير موجود" Else Me.Recordset.FindFirst "hno=" & Me.tn End If Me.tn.SetFocus Me.tn = "" ومع اني لا اعرف كيف وصل المؤشر هناك ، ولكن ، بما ان في هذا النموذج هو للبحث فقط ، فيمكن قفل هذا الحقل من التعديل ، هكذا : . جعفر

بارك الله فيك اخي الكريم

جزاك الله خير اخي @أبو عبدالله الحلوانى كتب الله اجرك

جرب هذا الكود (لا تنس اضافة صف فارغ تماماً في كل صفحة الصف رقم 6 /مخفي لعدم الكتابة فيه عن طريق الخطأ) Option Explicit Sub taj() Dim P As Worksheet Dim D As Worksheet Dim m%, i%, Rod, Rop% Dim Obj As Object Set D = Sheets("DATA") Set P = Sheets("print") Set Obj = CreateObject("System.Collections.ArrayList") Rod = D.Cells(Rows.Count, 1).End(3).Row Rop = P.Cells(Rows.Count, 1).End(3).Row If Rod < 7 Then Exit Sub D.Cells(7, "H").Resize(Rod).ClearContents With Obj For i = 7 To Rod If Not .contains(D.Cells(i, 1).Value) And _ D.Cells(i, 1) <> vbNullString Then .Add D.Cells(i, 1).Value End If Next i .Sort D.Cells(7, "H").Resize(.Count) = _ Application.Transpose(.ToArray) End With With D.Cells(3, "D").Validation .Delete .Add 3, Formula1:=Join(Obj.ToArray, ",") End With With P.Cells(3, "B").Validation .Delete .Add 3, Formula1:=Join(Obj.ToArray, ",") End With Set Obj = Nothing End Sub الملف مرفق Issa_Macro.xlsm

اخى الكريم ابا جودى اشكرك جزيل الشكر على المساعدة الكود المرفق تم إضافة اسم المجلد الى اسم الصورة تم الاضافة الى الكود ShortPath = DBPath & "Scan" & "\" & FDName الف شكر حقا منتدى رائع

فى الكود تبعك ابحث عن السطر التالى ShortPath = DBPath & FDName وقم بتغييره الى هذا السطر ShortPath = DBPath & "اسم المجلد" & FDName مع استبدال اسم المجلد طبعا حسب الاسم الذى تريدعلى ان يكوم نفس اسم المجلد بنفس مسار قاعدة البيانات موجود

بشركم الله تعالى بكل الخيــــــــر جزاكم الله خيـــــرا

وعليكم السلام - يمكنك ذلك بهذه المعادلة =IF(RIGHT($A2,2)=C$1,TRIM(MID(SUBSTITUTE(C$1&$A2,C$1,REPT(" ",50)),COLUMN(A1)*50,50)),"") Book1.xlsx

انا كنت اتحدث عن هذا المرفق بارك الله فيك

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

بس لاحظ اخي الكريم كلمة قسط قرض خاص بعميل وكلمة سمسارة لعميل اخر ولا يوجد في سجلات العميل الاول كلمة سمسارة .. هل تريد اضافتها للجميع مثلا

سؤال غير مفهوم ... انظر الصورة ماذا تريد هل تريد دمج الحقل المشار الية بالاحمر وعمل جمع لبيقة الحقل ؟؟؟؟؟؟؟

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

استكمالا لردي السابق كما تعلم استاذنا @jjafferr وبدون الدخول في التفاصيل ان هذه الطريقة تحتاج الى عدة خطوات والخطا قد يؤدى الى تلف قاعدة البيانات او حذف كافة الاكواد لذا لا افضل هذه الطريقة واستخدم طرق اخرى منها الطريقة الثانية عن طريق عمل Patch نفتح بواسطته الملف المحمي ويقوم بكامل العملية هذه الطريقة هي الاسهل والاكثر امان وبعد انتهاء العمل يمكن الاحتفاظ بالباتش لاستخدامه مع اي قاعدة بيانات اخرى هنا لن نستخدم احرف بشكل مباشر وانما التمثيل الست عشري الطريقة الثالثة بدون استخدام برامج خارجية عن طريق قاعدة بيانات اخرى نختار القاعدة المطلوب كسرها وتنفيذ عملية الكسر عن طريق كود بسيط انا افضل الطريقة الثانية واستخدمها عند الحاجة طبعا الموضوع ليس بتلك الاهميه ولكن من باب الشيء بالشيء يذكر

السلام عليكم الهرم السكاني 2.xlsx

اذا كان هناك فراغات يمكن ان نتجاوزها بهذا الكود و لا لزوم لما لا يلزم من وضع 2 Arrays واحد لكل شيت Option Explicit Sub All_in_One() Dim First As Worksheet Dim arr(1), Sh, i%, x% Dim dic As Object Set First = Sheets("Sheet1") Set dic = CreateObject("Scripting.Dictionary") arr(0) = "Sheet2": arr(1) = "Sheet3" First.Range("B1").CurrentRegion.ClearContents For Each Sh In arr x = Sheets(Sh).Cells(Rows.Count, 2).End(3).Row i = 2 Do Until i > x If Sheets(Sh).Range("B" & i) <> "" Then dic(Sheets(Sh).Range("B" & i).Value) = vbNullString End If i = i + 1 Loop Next Sh If dic.Count Then First.Range("B2") = "Names" First.Range("B3").Resize(dic.Count) = _ Application.Transpose(dic.keys) First.Range("A3").Resize(dic.Count) = _ Evaluate("Row(1:" & dic.Count & ")") End If Set dic = Nothing: Set First = Nothing Erase arr End Sub

جرب هذه المحاولة بمجرد الكتابة في الخلية c2 سيتم جلب البيانات غير اسماء الشيتات اجعل ورقة البيانات"data" وورقة التقرير report وضع الكود في ورقة التقرير Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("c2")) Is Nothing Then Sheets("data").Cells.AutoFilter Field:=1, Criteria1:=Target.Value Sheets("data").AutoFilter.Range.Columns("A:q").Offset(1).Copy Sheets("report").Range("A10") End If Sheets("data").AutoFilterMode = False End Sub

جرب المرفق تقرير.xlsm

عليك استخدام هذه المعادلة طبقاً لطلبك =IF(A3="","",IF($A3="Can limon",0%,IF($A3="Rosie",100%,70%))) New Microsoft Excel Worksheet1.xlsx

اتا ارى من الافضل ادراج الاسماء في فائمة منسدلة مطاطة (لا الأرقام) مطاطة اي انها تستجيب لاي تغيير في قائمة الاسماء(نعديل/ اضافة/حذف....) اذا لم تظهر لك القائمة المتسدلة غادر الصفحة (Cerificats) ثم عد اليها مجدداً الملف مرفق Notes.xlsm

تفضل-يمكنك استخدام هذه المعادلة =IFERROR(IF(COUNTIF($B$4:B4,B4)=1,U4&VLOOKUP($B4,$U$1:$V$2,2,0),U4&VLOOKUP($B4,$U$1:$V$2,2,0)+(COUNTIF($B$4:B4,B4)-1)),"") ترقيم وتسلسل.xlsx

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

السلام عليكم .. على سبيل التخمين لأنني لا أدري ما المطلوب إلى الآن .. جرب الكود التالي Sub text() Dim ws As Worksheet Dim a As Variant Dim c As Range Dim i As Long Dim r As Long Dim ss As Long Set ws = ActiveSheet a = ws.Range("A2:B" & ws.Cells(Rows.Count, 2).End(xlUp).Row).Value For i = LBound(a, 1) To UBound(a, 1) If a(i, 2) <> "" Then r = r + 1: a(i, 1) = r Else r = 0: a(i, 1) = "" End If Next i ws.Range("A2").Resize(UBound(a, 1), UBound(a, 2)).Value = a TextBox2.Visible = True TextBox5.Visible = False If Me.TextBox6.Value <> "" Then ss = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 Me.TextBox2.Value = ss Else Me.TextBox2.Value = "" End If End Sub

السلام عليكم ورحمة الله وبركاته بارك الله فيك أخي معتصم واسمح لي بإضافة الدالة (GETPIVOTDATA) تختص بالتعامل مع الجداول المحورية و تمتاز الدالة بإمكانية البحث في الجداول المحورية وفقا للكثير من العناصر في تسمية الصفوف وفي تسمية الأعمدة إلا أن الدالة تعيد النتيجة من حقل القيم فقط . أما استخدام دوال البحث الأخرى فذلك ممكن وللتغلب على مشكلة عدم ثبات طول نطاق الجداول المحورية نستخدم - نطاق ذو مدى متغير- بواسطة معادلات , ومن افضل المعادلات المستخدمة لتحديد طول المدى هي الدالة (GETPIVOTDATA) نظرا لأنها لا تسبب بطئ للملف. والدالة (GETPIVOTDATA)في هذه الحالة تحتاج إلى حقل أجمالي عدد البيانات. وللعلم الدالة (GETPIVOTDATA) اكثر سرعة في إعادة النتائج مقارنة بدوال البحث الأخرى ويمكن ملاحظة ذلك عند البحث في بيانات كبيرة الرابط التالي يحتوي على مثال لاستخدام الدالة GETPIVOTDATA http://www.officena.net/ib/index.php?showtopic=38907 في امأن الله

السلام عليكم ورحمة الله وبركاته الدالة GETPIVOTDATA تتعامل مع الجداول المحورية شاهد المرفق sales analysis.zip

السلام عليكم ورحمة الله أخي الكريم تعقيبا لما ذكره أخي الكريم أبو البراء في رده الأول فالأمر كماقال، إن في ملفك خلايا من الأعمدة الأخيرة في الورقة غير فارغة إما مملوءة بمعطيات أم أنك قمت بتلوين كامل لبعض (سطر أو أكثر) الأسطر وبالتالي يجب القيام بما يلي: 1- مسح محتويات هذه الخلايا إذا لم تكن بحاجة إليها (ولو من فراغات) 2- إزالة (مهم جدا وأعتقد أن هذه هي مشكلتك) تلوين الأسطر الملونة كاملة (جعلها دون لون وليس بالأبيض) وإن شاء الله ستتمكن من إدراج أسطر جديدة... أخوك بن علية