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

تم عمل المطلوب بطريقة بدائية جرب المرفق ووافني بملاحظاتك حساب المدير : اليوزر = 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

السلام عليكم ورحمه الله وبركاته هدية لأعضاء المنتدى الكرام برنامج أرشفة الخطابات و الوثائق .. الأرشفة الالكترونية مفتوح للعمل عليه غير محدد المدة ومش تجريبي مغلق المصدر (الاكواد) وتعديل النماذج تحياتي user 1234 1118021174_Archivesopen18-1-2021.rar

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

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

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

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

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

بس ولا تعصب علينا جرب هذا ووافنا بالنتائج ولا تنسنا من دعائك مثال 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

بسبب . يجب ان يكون الكود يراعيها ، هكذا : If IsNumeric(a) = False Then m_ar = a ElseIf Val(a) < 20 And IsNumeric(a) Then m_ar = "عربي" Else m_ar = "" End If جعفر

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

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

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

جرب الكود التالي Dim dbB as DAO.Database Set dbB = DBEngine.Workspaces(0).OpenDatabase("D:\Folder\File", _ True, True, ";pwd=XXX") DoCmd.TransferDatabase acImport, "Microsoft Access", _ dbB.Name, acTable, "MyTable", "MyTable" .... dbB.Close Set dbB = Nothing 3 خطوات: 1. غيّر كلمة مرور قاعدة البيانات التي تريد التصدير إليها "". 2. تصدير الجداول. 3. أعد كلمة المرور إلى ما كانت عليه في الأصل.باستخدام المود التالي للقيام بذلك: Function SetDBPassword(strDBPath As String, _ strOldPwd As String, _ strNewPwd As String) ' This procedure sets a new password or changes an existing ' password. Dim dbsDB As DAO.Database Dim strOpenPwd As String ' Create connection string by using current password. strOpenPwd = ";pwd=" & strOldPwd ' Open database for exclusive access by using current password. To get ' exclusive access, you must set the Options argument to True. Set dbsDB = OpenDatabase(Name:=strDBPath, _ Options:=True, _ ReadOnly:=False, _ Connect:=strOpenPwd) ' Set or change password. With dbsDB .NewPassword strOldPwd, strNewPwd .Close End With Set dbsDB = Nothing End Function

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

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

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

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

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

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

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

جرب هذا الكود (لا تنس اضافة صف فارغ تماماً في كل صفحة الصف رقم 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

وعليكم السلام 🙂 حتى لا يحدث لك هذا مرة ثانية: 1. تأكد بأن برنامج الاكسس فيه آخر التحديثات ، 2. هذا قد يكون بسبب بعض تحديثات مايكروسوفت للوندوز ، من موقع مايكروسوفت: Access reports that databases are in an 'inconsistent state' - Access (microsoft.com) - يكفي عمل هذا العمل على السيرفر (او الكمبيوتر الذي عليه نسخة الجداول) ، ولا يضر ان تعمله على كمبيوتر الواجهة وكمبيوتر الجداول : - افتح برنامج CMD كمسؤول ، Windows Start and then type Command. Right-click on Command Prompt and choose Run as administrator - ثم اكتب هذه الاسطر الثلاث (انسخ اول سطر من هنا ، والصقه هناك ، واضغط على زر Enter لتنفيذ الامر ، ثم الصق الثاني ونفذ الامر ، ثم الثالث ونفذ الامر) : REG ADD HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\lanmanserver\parameters /v DisableLeasing /t REG_DWORD /d 1 /f NET STOP SERVER NET START SERVER . والآن ، اعمل ضغط واصلاح لقاعدة البيانات ، وجربها في المحيط الجديد 🙂 جعفر

فى الكود تبعك ابحث عن السطر التالى 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

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

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

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

جرب هذا الماكرو Option Explicit Sub checK_up() Dim F As Worksheet Dim Arr(), Itm, My_sum Dim m%, K%, i%, Ro%, y% Dim arr_madda() Dim Res(), XX%, MY_text$ Dim Txt$: Txt = "المجمــــــــــوع" Set F = Sheets("F1") Ro = F.Cells(Rows.Count, 3).End(3).Row If Ro < 12 Then Exit Sub F.Cells(12, "H").Resize(Ro - 11, 49).Interior.ColorIndex = xlNone F.Cells(12, "Ca").Resize(Ro - 11, 49).ClearContents F.Cells(12, "Bx").Resize(Ro - 11).ClearContents For K = 8 To 55: If F.Cells(9, K) = Txt Then ReDim Preserve Arr(m): Arr(m) = K: m = m + 1 End If Next m = 0 For K = 8 To 50 If F.Cells(6, K) <> "" Then ReDim Preserve arr_madda(m): arr_madda(m) = F.Cells(6, K) m = m + 1 End If Next For i = 12 To Ro y = 0 For Each Itm In Arr My_sum = My_sum + F.Cells(i, Itm) If F.Cells(i, Itm) < F.Cells(10, Itm) / 2 Then F.Cells(i, Itm).Interior.ColorIndex = 6 ReDim Preserve Res(y) Select Case Itm Case Is <= 13: Res(y) = arr_madda(0) Case Is <= 20: Res(y) = arr_madda(1) Case Is <= 27: Res(y) = arr_madda(2) Case Is <= 34: Res(y) = arr_madda(3) Case Is <= 41: Res(y) = arr_madda(4) Case Is <= 48: Res(y) = arr_madda(5) Case Is <= 55: Res(y) = arr_madda(6) End Select y = y + 1 End If Next Itm If y > 1 Then F.Cells(i, "Ca").Resize(, y) = Res Else F.Cells(i, "Bx") = My_sum End If Erase Res: y = 0: My_sum = 0 Next i End Sub الملف مرفق Khiri_ali.xlsm

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

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

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

جرب هذه المحاولة بمجرد الكتابة في الخلية 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

في المثال المرفق تجد الطريقة و عدة طرق طرق لنقل البيانات و شرح مفصل لكل العمليات SyncDataExample_v5.3.zip

جرب هذه المعادلة (Crtl+Shift+Enter) وليس Enter وجدها =VLOOKUP(SUM(IFERROR(IF(ISNUMBER(FIND({"Can limon";"Rosie"},A3)),ROW($A$1:$A$12),""),"")),{0,0;1,100;2,70},2,0) File included vlk_Find.xlsx

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

تفضل-يمكنك استخدام هذه المعادلة =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- إزالة (مهم جدا وأعتقد أن هذه هي مشكلتك) تلوين الأسطر الملونة كاملة (جعلها دون لون وليس بالأبيض) وإن شاء الله ستتمكن من إدراج أسطر جديدة... أخوك بن علية