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

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

تفضل client4.mdb

ابن فلسطين الغالي: يجب ان تكون قاعدة بياناتك كالتالي: جدولين: الجدول الاول: يحتوي على رقم الزبون، اسم الزبون، الدفعة الجدول الثاني: النوع، الثمن الآن: يتم عمل نموذج باسم الزبون والدفعة الكاملة وفي مثالك 200 في نفس النموذج نضع نموذج فرعي للدفعات وووو في الفرعي نضع المعادلات اللازمة : نجمع الدفعات وونقصها من الدفعة الثابتة 200 في حال تجاوز الدفعة الثابتة نضع ايضا معادلة تخبرنا اننا تجاوزنا هل تريد مثلا تحديث الدفعة الثابتة ام لا ووو لضيق الوقت لم اطبق لك هذا ولكن ان لم تستطع التوصل لحل اخبرني وسوف نتعاون في ذلك حبذا لو تكون المسميات بالحروف الانجليزية لسهولة العمل مستقبلا :: تحياتي

ادراج رزنامة شهرية لسنة معينة و شهر معين (باختيارك) بدون يوم او يومين تحددهما بنفسك و اذا لم تحدد الايام (بمسح الخلايا المناسبة) يتم ادراج كامل الشهر Sub Give_date_without_same_days() With CommandButton1 .Left = 469: .Top = 18.5: .Width = 154.5 End With If Not IsNumeric([a2]) Or Not IsNumeric([b2]) _ Or [b2] < 1 Or [b2] > 12 _ Or IsEmpty([a2]) Or IsEmpty([b2]) Then MsgBox "أدخل أرقاماً صحيحة في الخلايا " & Chr(10) & "$ِِِA$2 and $B$2 " & Chr(10) _ & "وأعد المحاولة", vbOKOnly + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "!...ٍSalim" Range("c4:Ag5").ClearContents Range("c4:Ag5").Borders.LineStyle = 0 GoTo Exit_Me End If With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlManual End With Dim Array_Days(), My_Days_Arabic() Dim Arab_Day(), My_Date_For_Print() Dim Array_Numbers() Dim t As Date, i%, k%, m%, x%, last_col% Dim y$ '============================== Array_Days = Array("sun", "mon", "tue", "wed", "thu", "fri", "sat") Arab_Day = Array("الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس", "الجمعة", "السّبت") Array_Numbers = Array(1, 2, 3, 4, 5, 6, 7) last_col = Cells(5, Columns.Count).End(1).Column Range("c4").Resize(2, last_col).ClearContents Range("c4").Resize(2, last_col).Borders.LineStyle = 0 '================================= [a2] = Int([a2]): [b2] = Int([b2]) t = DateSerial([a2], [b2], 1) x = Day(Application.EoMonth(t, 0)) k = 1 For i = 1 To x y = Application.Index(Arab_Day, Application.Match(Weekday(t), Array_Numbers, 0)) If Trim(y) = Trim([d2].Value) Or _ Trim(y) = Trim([e2].Value) Then GoTo 2 ReDim Preserve My_Days_Arabic(1 To k): My_Days_Arabic(k) = y ReDim Preserve My_Date_For_Print(1 To k): My_Date_For_Print(k) = t k = k + 1 ' End If 2: t = t + 1 Next Range("C4").Resize(1, UBound(My_Days_Arabic)) = My_Days_Arabic Range("C5").Resize(1, UBound(My_Date_For_Print)) = My_Date_For_Print Range("C4").Resize(2, UBound(My_Days_Arabic)).Borders.LineStyle = 1 ActiveSheet.PageSetup.PrintArea = "" ActiveSheet.PageSetup.PrintArea = Range("a1").Resize(6, UBound(My_Days_Arabic) + 2).Address Exit_Me: Erase Array_Days: Erase Arab_Day: Erase Array_Numbers With Application .ScreenUpdating = True .Calculation = xlAutomatic .EnableEvents = True End With End Sub Private Sub CommandButton1_Click() Give_date_without_same_days End Sub Private Sub Worksheet_Activate() With CommandButton1 .Left = 469: .Top = 18.5: .Width = 154.5 End With End Sub الكود موجود ضمن الملف Date_sans_deux_jours.xlsm

بارك الله فيك اخي العزيز لا يوجد سؤال ساذج اخي فرب سؤال بسيط قد يفوت على ذوي الخبرة و رب سؤال صعب يسهل على المبتدئين امثالي و امثالك و لكن بالبحث و الاجتهاد بإذن الله سنجد ما نريده ... كل ما تحتاجه معرّف بالوحدة النمطية .... ايضاً اضع لك مثال اخر وجدته بالبحث في النت و هو يوضح موقع مؤشر الماوس باي موقع ( بتفصيل النموذج ) على النموذج و ايضاً هذا المثال كل شئ معرف بداخل القسم العام لوحدة النموذج بالتوفيق CursorMovement2000.rar

حياك الله عزيزي sandanet انا عدلت على المرفق من قبل الطيب ابو زاهر لو نظرت الى طلبه لرأيت انه يريد اضافة الكمية والموقع في الرسالة وانا قمت باضافتها فقط هو الذي استخدم امر IF فائدتها هنا فقط لجعل الخط غامق في الرسالة

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

أخي الكريم ابو زاهر الملف المرفق يؤدي نفس الغرض بدون استخدام دالة Eval وعبارة if وانا بصراحة لا اعلم لماذا تم استخدامها في تعديل الاستاذ @AlwaZeeR اود معرفة سبب استخدامها اذا تكرم وشرح لنا فائدتها هنا wazسبق جرده.mdb

تفضل .. اخي الكريم انصحك بشدة الابتعاد عن الكلمات العربية في مسميات مربعات النص لانك ستواجه مشاكل كثيرة معها فيما بعد db1.mdb

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

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

السلام عليكم الأستاذ / نبيل عبد الهادى الواضح حضرتك أرفقت ملف عن طريق الخطأ حيث أن الكود المرفق غير المطلوب على العموم بعد إذن حضرتك هذا ملف به كود يفى بالغرض المطلوب Test11.rar

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

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

شوف هل هذا ما تقصده Me.FooterReTotal = (SoldQu - ReturnedQu) * Pro_Price اذا كان هو فاجعل بعد الثحديث عند القميه وعند السعر Test41.accdb

اخي الكريم ابوحمادة الرجاء اعادة ارفاق الملف لانك ارفقت صفحة ويب بدلاً من الملف

عند عرض بعض التقارير في اكسس 2010 تظهر رسالة لا يمكن عرض التقرير بسبب ان الذاكرة ممتلئة

وعليكم السلام اختي الكريمة انظري الملف المرفق عساه يكون المطلوب سوال1.xlsx

جرب هذا الملف dATE_IF.xlsx

لا والله لم اجد حل لكن استبدلت الخطوط لجميع برامجي وجعلتها Arial ومن وقتها الى الان لم ترجع لي مشكلة تغيير الخطوط في التقرير

بارك الله في السائل و المجيب و كل من شارك

وعليك السلام استادنا الفاضل وائل المثال بعيد جدا عن ما اتكلم عنه الى السيد الفاضل ابو ياسين توصلت لشبه حل وهو ان يكون نمودج الفرعي مبني على استعلام التجميع عند اضافة صنف مشابه يثم تجميع عدد الكمية فهدا مجرد حل انظر فيه

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

ضع تحت امر الجلب: N3 = DLookup("Price", "FiFo", "FifoNo =" & Nz([N2], 0) & " And Item =" & Nz([N1], 0)) N4 = DLookup("Qut", "FiFo", "FifoNo =" & Nz([N2], 0) & " And Item =" & Nz([N1], 0)) FIFO.rar

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

استخدم امر: Me.Grand_Total.Requery في حدث بعد التحديث لحقل الادخال: Total ولكن الافضل كما ذكرت لك سابقا :: تحياتي

شكر اليك استاذي ابو ياسين على المشاركه النسخه عندي بستبدلها اليوم ان شاء الله

انا كمان استخدم 2010 وواضح عندي

المرفق الذي ارفقته لك فيه ما طلبت

حسب ما فهمت : تريد الحقول: رأس موضوع1E رأس موضوع 2 رأس موضوع 3 في عمود واحد وبدون تكرار لا تعتذر اخي العزيز فهذا ليس تطفلا لا سمح الله من واجب صاحب العلم ان لا يكتم علما وهذا عملنا خالصا لله حياك الله عزيزي وان كان ليس هو المطلوب فقم بالتفصيل اكثر حتى نصل الى ما تريد :: تحياتي db1waz 22.rar

تفضل db1waz.rar

اذا كنت تقصد حماية الورقة وليس المصنف ويمكن عمل ذلك التوافق من خلال الاكواد في المثال ادناه : - الكود الاول تصفية مع وجود الحماية ضمن عمود ونطاق معين ومعيار التصفية هنا الحرف (A) - الكود الثاني الغاء التصفية بوجود الحماية - نضع سطر الغاء الحماية في بداية الكود - ونضع سطر تفعيل الحماية في نهاية الكود - وعلى افتراض ان الباسورد هنا 123 Sub Worksheet_Protection_Filter() Application.ScreenUpdating = False ActiveSheet.Unprotect Password:="123" Columns("H:H").Select Selection.AutoFilter ActiveSheet.Range("$H$1:$H$18").AutoFilter Field:=1, Criteria1:="A" Range("H1").Select ActiveSheet.Protect Password:="123" End Sub Sub Cancel_filter() Application.ScreenUpdating = False ActiveSheet.Unprotect Password:="123" Cells.Select ActiveSheet.ShowAllData ActiveSheet.Protect Password:="123" End Sub file all.xlsm

لا شكر على واجب انا شاء الله الاستاذ ابو ياسين وبقيه الاخوان ما بيقصرو معاك اذا قدرت اعمل شي ابشر تحياتي

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

جرب هذا التطبيق على الاكواد الموجودة في حدث الزر If SavRef = 2 Or SavRef = 3 Then Call Form_Close Call Form_formT2.undo_subform DoCmd.GoToRecord , , acNewRec Else DoCmd.GoToRecord , , acNewRec End If test_UP4.rar

اتفضل المثال يعمل بصوتين مختلفين الاول من الملف المرفق لو موجود فى نفس المجلد بنفس مسار القاعدة وفى حالة عدم وجوده يستخدم صوت من اصوت النظام ...حلوة الفكرة دى play sound.rar للتأكد من عمل المرفق بصوتين للانذار مختلفين رجاء بعد التجربة حذف المجلد schoolbell او تغيير اسمه واعادة المحاولة مرة اخرى لتجد ان صوت التنبيه قد تغير كل الشكر والتقدير والعرفان للاستاذ المبجل @أبو آدم صاحب فكرة تنسيق صندوق الرسائل

وعليكم السلام ممكن تجرب ده اسم المستخدم : كريم وكلمة المرور : 4444 كريم 4444-المرتبات بعد التعديل.xlsm

السلام عليكم بعد اذن استاذنا الغالي شيفان و اسأل الله ان يجعل ما يقدمه لخدمة اخواننا في موازين حسناته يمكن استبدال تلك الرسالة بوضع الكود التالي بحدث عند الخطأ لنموذج البدء If DataErr = 3043 Or DataErr = 3024 Or DataErr = 3044 Or DataErr = 3078 Then Response = MsgBox("اتصال خاطئ بالمصدر", vbExclamation, "اتصال خاطئ") Response = acDataErrContinue DoCmd.RunCommand (acCmdLinkedTableManager) DoCmd.Quit End If و حل آخر تجده بالرابط ادناه للاستاذ الغالي ابو خليل جزاه الله كل خير تفضل من هنا بالتوفيق

طلب الي احد الاصدقاء وضع كود لادراج رزنامة لسنة محددة وشهر محدد مع تمييز (يوم معيّن) من هذا الشهر فكان هذا الكود الذي ارجو ان يستفيد منه الاخرون قبل تنفيذ الكود الكود: تسمية الصفحة التي تريد العمل عليها بهذا الاسم "Salim_Calendar" اكتب في الخلية B1 رقم السنة في الخلية B2 رقم الشهر في الخلية G1 رقم اليوم المييز الكود Option Explicit Option Base 1 Sub My_Calandar() If ActiveSheet.Name <> "Salim_Calendar" Then Exit Sub Dim t As Date, i As Byte Dim Arab_day(), m% Dim EnG_day(), rows_count As Byte Dim col As Byte Dim r As Byte Dim search_day As Date rows_count = Range("b4").CurrentRegion.Rows.Count + 3 Range("b4:H" & rows_count).ClearContents Range("b5:h10").Interior.ColorIndex = 0 '''''''''''''''''''''''''Conditions for working'''''''''''''''''' If Not IsNumeric([b1]) Or Not IsNumeric([b2]) _ Or [b1] < 1 Or [b2] > 12 Or [b2] < 1 Then MsgBox "Type Valid Numbers in cell(B1) & cell(B2)": Exit Sub End If ''''''''''''''''''''''''' End of Conditions for working'''''''''''''''''' r = 5 t = DateSerial([b1], [b2], 1) '''''''''''''''''''''''''Conditions for Special Day'''''''''''''''''' If Not IsNumeric([g1]) Or [g1] > Day(Application.EoMonth(t, 0)) _ Or [g1] < 1 Then [g1] = 1 Else [g1] = Int([g1]) End If '''''''''''''''''''''''''End of Conditions Special Day'''''''''''''''''' search_day = DateSerial([b1], [b2], [g1]) Arab_day = Array("الأحد", "الإثنين", "الثلاثاء", _ "الأربعاء", "الخميس", "الجمعة", "السّبت") ' EnG_day = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat") Range("b4").Resize(, 7) = Arab_day m = Weekday(t) + 1 For i = 1 To 31 Cells(r, m) = t If t = search_day Then Cells(r, m).Interior.ColorIndex = 3 Else Cells(r, m).Interior.ColorIndex = 35 End If If Month(t + 1) > [b2] Then Exit For t = t + 1 m = m + 1 col = Cells(r, m).Column If col > 8 Then r = r + 1: m = 2 Next Erase Arab_day End Sub الملف مرفق My_Calendar.xlsm

وهي الطريقة التي استخدمها في اعمالي وحدة نمطية وكود للربط داخل النموذج انسخ الكود التالي والصقه في وحدة نمطية عامة Public Function CheckLinks(ByVal strDBPassword As String) As Boolean On Error GoTo CheckLinksErr Dim tdf As TableDef Dim strNewMDB As String Dim fd As FileDialog For Each tdf In CurrentDb.TableDefs If UCase(Left(tdf.Name, 6)) <> "COMPAS" Then If Len(tdf.Connect) > 0 And tdf.Fields.Count = 0 Then If Len(strNewMDB) = 0 Then Call MsgBox("مطلوب قم بتحديده واختياره (اسم قاعدة الجداول لديك) ملف البيانات", vbCritical) Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = False .InitialFileName = CurrentDBFolder() .Filters.ADD "Access Database File (*.mdb)", "*.mdb", 1 .TITLE = "Select Back-End Data File" .ButtonName = "Link Tables" If .Show = False Then Exit Function Else strNewMDB = .SelectedItems(1) End If End With End If If (IsNull(strDBPassword) = True) Or (strDBPassword = "") Then tdf.Connect = ";DATABASE=" & strNewMDB Else tdf.Connect = ";DATABASE=" & strNewMDB & ";PWD=" & strDBPassword End If tdf.RefreshLink End If End If Next tdf CheckLinks = True CheckLinksDone: Exit Function CheckLinksErr: MsgBox "Error #" & err.Number & ": " & err.Description, vbCritical Resume CheckLinksDone End Function Public Function CurrentDBFolder() As String Dim strPath As String strPath = CurrentDb.Name Do While Right$(strPath, 1) <> "\" strPath = Left$(strPath, Len(strPath) - 1) Loop CurrentDBFolder = strPath End Function ثم الصق الكود التالي في حدث التحميل لنموذج البداية On Error Resume Next If CheckLinks("") = False Then Call Quit End If Dim tdfs As DAO.TableDefs Dim tdf As TableDef Dim sSourceDB As String Dim sBackupDB As String Dim backDBName As String Set tdfs = CurrentDb.TableDefs Set tdf = tdfs(tdfs.Count - 1) sSourceDB = Right(tdf.Connect, Len(tdf.Connect) - 10) backDBName = Dir(Mid(tdf.Connect, 11)) sBackupDB = Mid(tdf.Connect, 11, Len(tdf.Connect) - (Len(backDBName) + 10)) ' وفي المثال تطبيق للمقال ملحوظة : اذا لم يعمل المثال على الوجه الأكمل انظر في المكتبات link_be.rar

السلام عليكم ورحمة الله وبركاته هذا الرابط يحتوي على الكثير من الدوال والتي تم تضبيطها للعمل على الاكسس 32بت و 64بت: http://www.jkp-ads.com/articles/apideclarations.asp فقط ابحث عن الدالة ، واعمل نسخ/لصق للكود وهذا رابط آخر فقط لدوال 64بت (المعدّلة من 32بت): http://www.utteraccess.com/wiki/index.php/Category:API جعفر

السلام عليكم جرب المرفق و لا ادري ان كانت هناك اخطاء او لا الصادر و الوارد_.rar

السلام عليكم أخي أبو مهند الخضري سأرى قريبا كل ملاحظاتك ان شاء الله ***************************************************** أخي أحمد ريان يمكن عمل ذلك لكن بتغيير في الكود ***************************************************** أخي يوسف السيد جزاكم الله خيرا على المرور *****************************************************