osama457

الأستاذ / السيد عبد العال لست متخصصا في الرياضيات ولا أفهم في المحاسبة بحثت عن دالة جاهزة فما لقيت، وعن معادلة بسيطة وما لقيت أيضا لكني لقيت معادلة غير بسيطة وتكرارية في الرابط : http://mathforum.org/library/drmath/view/52628.html وصغتها في كود ولما جيت أنزلها هنا لقيتك سبقتني بالجواب الصحيح فعلا ومن باب الطرفة أكتب الكود اللي توصلت له ((خاصة إني بذلت فيه مجهود ساعة تقريبا )) :$ طبعا لا يصح استخدامه ما دام يغني عنه الكود السابق Function CubeRoot(ByVal inNum As Variant) As Variant If Not IsNumeric(Nz(inNum, "")) Then Exit Function Dim x As Variant x = 0 Do Until CStr(x ^ 3) = CStr(inNum) If x = 0 Then x = x - (x ^ 3 - inNum) Else x = x - (x ^ 3 - inNum) / (3 * x ^ 2) End If Loop CubeRoot = x End Function

شكرا أستاذنا لكن هل الجواب الذي كتبته لا يقبل الأرقام السالبة؟ إن كان كذلك فأظنه يمكن تلافي ذلك بالعبارة IIf([t_Num]<0;(Abs([t_Num])^(1/3))*-1;[t_Num]^(1/3)) مع استبدال كلمة [t_Num] باسم الحقل الذي يحتوي على الرقم

جرب أن تكتب العبارة التالية في استعلام Expr1: Fix([s_Mark])+Switch(([s_Mark]-Fix([s_Mark]))<=0.25;0;([s_Mark]-Fix([s_Mark]))>=0.75;1;([s_Mark]-Fix([s_Mark]))<0.75;0.5) واستبدل [s_Mark] باسم الحقل الذي يحتوي الرقم عندك وهذا مثال FixMark11.zip

هذا مثال PrintForm33.zip

الأفضل أن تكون الطباعة لتقرير بدلا من نموذج إذا كان ذلك ممكنا وفي حال إصراراك على طباعة النموذج جرب ما يلي : عن طريق المعالج اعمل زر يفتح النموذج الثاني على السجل الحالي في النموذج الأول ثم استبدل العبارة DoCmd.OpenForm stDocName, , , stLinkCriteria بالعبارة التالية (من سطرين ) : DoCmd.OpenForm stDocName, acPreview, , stLinkCriteria, , acHidden, "ForPrint" DoCmd.Close acForm, stDocName ثم في النموذج الثاني المطلوب طباعة اكتب في حدث عند التنشيط (Activate) If Me.OpenArgs = "ForPrint" Then DoCmd.PrintOut End If للفائدة الأمر DoCmd.PrintOut له خيارات متعددة يمكنك مراجعتها في التعليمات

طلب الأخ هاوي في موضوع مستقل أن يكون البحث بأكثر من حقل ، ولهذا تم التعديل في الكود ليصبح كالتالي Sub SpeedRecSource(ByVal InText1 As String, ByVal InText2 As String, ByVal InText3 As String) Dim MyFilter1 As String, MyFilter2 As String, MyFilter3 As String If InText1 <> "" Then InText1 = "(([First_Name]) Like '" & InText1 & "' & '*')" If InText2 <> "" Then InText2 = "(([Mid_Name]) Like '" & InText2 & "' & '*')" If InText3 <> "" Then InText3 = "(([Last_Name]) Like '" & InText3 & "' & '*')" If InText1 <> "" And InText2 <> "" Then InText2 = " And " & InText2 If (InText1 <> "" Or InText2 <> "") And InText3 <> "" Then InText3 = " And " & InText3 End If InText1 = InText1 & InText2 & InText3 If InText1 <> "" Then InText1 = " WHERE (" & InText1 & ");" Else InText1 = ";" Me.Child1.Form.RecordSource = "SELECT tbl1.* FROM tbl1" & InText1 End Sub ومرفق مثال SpeedSearch3Cntrl.zip

أظن الدالة في مثال أبو هادي umalqura_update الموجود على الرابط : منتديات أوفيسنا -> قسم الأكسس -> دروس و خلاصة مشاركات الأكسس -> النماذج و أكواد ال VBA تقويم أم القري و التقويم الهجري http://www.officena.net/ib/index.php?showt...557&hl=أم+القرى تكتب بالشكل التالي =Greg2Um(Day(Date());Month(Date());Year(Date())) أو بالشكل التالي : =Hijri_Arabic(Greg2Um(Day(Date());Month(Date());Year(Date()))) حسب التنسيق المطلوب يعني إذا كان عندك مربع نص تريده أن يعرض تاريخ اليوم ، في خصايص مربع النص في مصدر عنصر التحكم اكتب الدالة السابقة

لماذا مربع نص ؟ اجعله مربع تحرير وسرد ونفرض أن اسمه cmbnn ، وأن الحقل اسمه nn ، والجدول اسمه tbl1 في خصايص مربع التحرير والسرد في حدث عند التغيير اكتب الكود التالي Private Sub cmbnn_Change() Dim InName As String Dim mySQL As String InName = Nz(Me.cmbnn.Text, "") If InName = "" Then mySQL = "SELECT tbl1.nn, Count(*) AS Expr1" _ & " FROM tbl1" _ & " GROUP BY tbl1.nn" _ & " ORDER BY Count(*) DESC;" Else If Me.cmbnn.SelText = InName Then Exit Sub If Me.cmbnn.SelLength > 0 And Me.cmbnn.SelStart > 0 Then InName = Left(Me.cmbnn.Text, Me.cmbnn.SelStart) End If mySQL = "SELECT tbl1.nn, Count(*) AS Expr1" _ & " FROM tbl1" _ & " GROUP BY tbl1.nn" _ & " HAVING (((tbl1.nn) Like '" & InName & "' & '*'))" _ & " ORDER BY Count(*) DESC;" End If Me.cmbnn.RowSource = mySQL Me.cmbnn.Dropdown End Sub وهذا مثال وأدعو الاخوان للمشاركة في الكود السابق cmb_Change.zip

أخي الفاضل الحقيقة مشكلتك غير واضحة المقصود بالعبارة forms!MainForm1!Form1!text1 ما يلي forms تكتب كما هي ومعناها النماذج المفتوحة MainForm1 تستبدلها باسم النموذج الريسي اللي ذكرت انه ليس له مصدر Form1 تستبدلها باسم النموذج الفرعي داخل النموذج الريسي ، وليس اسمه الفعلي خارجه ، يعني اسم عنصر التحكم النموذج الفرعي ، فلو كان اسمه مثلا مستقلا هو Form2 لكن اسم النموذج الفرعي داخل النموذج الريسي Child1 تكون العبارة forms!MainForm1!Child1!text1 text1 تستبدلها باسم مربع النص داخل النموذج الفرعي

افرض انك في الاستعلام عبرت عن مربع النص بالعبارة : forms!Form1!text1 حيث Form1 هو الفورم الفرعي ، و text1 هو مربع النص هذا يمشي إذا كان Form1 مفتوح مباشرة ، أما إذا كان Form1 نموذج فرعي داخل نموذج رئيسي اسمه MainForm1 فيجب ان العبارة تكون بالشكل التالي : forms!MainForm1!Form1!text1

حسب ما فهمته عندك مربع نص اسمه Text0 هو اللي يبحث بواسطته عندك نموذج فرعي اسمه Child1 وفيه حقل t_Name في حدث عند التغيير في خصايص Text0 Private Sub Text0_Change() Dim MyStr As String MyStr = Nz(Me.Text0.Text, "") If MyStr = "" Then Me.Child1.Form.RecordSource = "SELECT tbl1.* FROM tbl1;" Else Me.Child1.Form.RecordSource = "SELECT tbl1.* FROM tbl1" _ & " WHERE (((tbl1.t_Name) Like '" & MyStr & "' & '*'));" End If End Sub وهذا مثال SpeedSearch2.zip

أفترض ان عندك جدولين : جدول الغرف وجدول الحركة اعمل استعلام جديد وخلينا نسميه( غير الشاغر ) لحركة الغرف ، فيه حقلين رقم الحركة ورقم الغرفة ، وفي المعايير ان تاريخ الخروج فارغ أو أكبر من أو يساوي اليوم الحاضر ، وعلى كذا الاستعلام يعرض الغرف غير الشاغرة الآن اعمل استعلام جديد ثاني تربط فيه جدول الغرف باستعلام (غير الشاغر) ، ومن خصائص الربط فيه انه يعرض جميع سجلات جدول الغرف ، وتلك السجلات فقط (من غير الشاغر) حيث تكون السجلات متطابقة . واعمل في معاييره ان حقل رقم الحركة (Is Null) ، يعني الغرفة ليست ممتلئة . وعلى كذا الاستعلام الثاني هو اللي يعرض الغرف الشاغرة . طبعا ممكن استبدال هذه الخطوات بأكواد ، لكن هذا يؤدي الغرض . وهذا مثال . EmptyRooms.zip

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

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

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

عدلت عليها بحيث الطالب الراسب يحسب له الدرجة الاقل (لكن بيني وبينك الا ترى ان هذا ظلم ؟؟) وأضفت استعلام ثالث مبني على كود في وحدة نمطية وشرحت على الوحدة النمطية بشرح حاولت انه يكون مفهوم وأنت مخير تاخذ بالاستعلام الاول ، او الثاني ، أو الثالث ، والثالث هو في رايي أفضل ، لأنه أسهل في الفهم وسهل التعديل عليه عن طريق التعديل في الكود أما الشيت اللي أرفقتها فالحقيقة ما عندي خلفية في الاكسل تماما ، لاني ما سبق عملت بشكل موسع عليه فاذا كنت تريد الموضوع على الاكسل فممكن بعض الاخوان هنا يكون عندهم خلفية أو تطرحها في قسم الاكسل يكون أفضل StuMarks2.zip

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

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

هذا هو الكود Public Type OPENFILENAME lStructSize As Long '========= hwndOwner As Long hInstance As Long lpstrFilter As String '========= lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String '========= nMaxFile As Long '========= lpstrFileTitle As String '========= nMaxFileTitle As Long '========= lpstrInitialDir As String '========= lpstrTitle As String flags As Long '========= nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Public Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long ' المسار الافتراضي ويعدل إلى المسار المطلوب Public Const MyDefaultFolder As String = "C:\My Documents" Public Function ChooseFile() As String On Error GoTo ChooseFile_mErr ' هذا الكود لاختيار ملف ' بواسطة مربع حوار اختيار ملف Dim ofn As OPENFILENAME Dim DirFile As String, mFileKind As String mFileKind = "doc" ofn.lStructSize = Len(ofn) ofn.lpstrFilter = mFileKind + " Files (*" + "." + mFileKind + ")" + Chr$(0) + "*" + "." + mFileKind + Chr$(0) ofn.lpstrFile = LastNum(MyDefaultFolder) & Space$(240) ofn.nMaxFile = 255 ofn.lpstrFileTitle = Space$(254) ofn.nMaxFileTitle = 255 ' السطر التالي لجعل المجلد الافتراضي هو المكتوب في الأعلى ofn.lpstrInitialDir = MyDefaultFolder ' لجعله يعرض المجلد حسب الطريقة المعتادة في الويندوز استبدله بالسطر التالي ' ofn.lpstrInitialDir = CurDir ofn.lpstrTitle = "اختيار اسم ومجلد للملف" ofn.flags = 0 Dim A A = GetOpenFileName(ofn) If (A) = False Then Exit Function DirFile = Trim$(ofn.lpstrFile) If Asc(Right(DirFile, 1)) = 0 Then DirFile = Left(DirFile, Len(DirFile) - 1) If Right(DirFile, 4) <> "." & mFileKind Then DirFile = DirFile & "." & mFileKind ChooseFile = DirFile Exit Function ChooseFile_mErr: Select Case Err.Number Case 32755: MsgBox "لم تحدد اسم الملف", 64, " خطأ " Case 20477: MsgBox " اسم خاطئ للملف", 16, " خطأ " End Select End Function Sub حفظ_تقليدي() On Error GoTo حفظ_تقليدي_Err Dim DirFile As String, FolderPath As String, Name_of_File As String Dim I As Integer DirFile = ChooseFile If DirFile = "" Then Exit Sub ' إذا كان يوجد ملف بنفس الاسم يتم سؤال المستخدم عن رغبته في الكتابة عليه If (Dir(DirFile)) <> "" Then If MsgBox("هناك خطاب يحمل نفس الاسم " & vbCrLf & vbCrLf _ & "هل تود الكتابة عليه ؟؟" & vbCrLf & vbCrLf _ & "انقر لا لإلغاء الحفظ ... انقر نعم للكتابة على الخطاب", _ vbInformation + vbYesNo + vbDefaultButton2, _ "تحذير") = vbNo Then ' يتم الخروج من بقية الكود في حال اختيار لا Exit Sub Else If MsgBox("هل أنت متأكد", _ vbInformation + vbYesNo, _ "تأكيد") = vbNo Then Exit Sub End If End If End If Do I = InStr(I + 1, DirFile, "\", 1) If InStr(I + 1, DirFile, "\", 1) = 0 Then Exit Do Loop If I = 0 Then Exit Sub FolderPath = Left(DirFile, I) Name_of_File = Right(DirFile, Len(DirFile) - I) MsgBox " DirFile = " & DirFile & vbCrLf _ & "FolderPath = " & FolderPath & vbCrLf _ & "Name_of_File = " & Name_of_File 'حفظ الخطاب ChangeFileOpenDirectory FolderPath ActiveDocument.SaveAs filename:=Name_of_File, FileFormat:=wdFormatDocument, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False Exit Sub حفظ_تقليدي_Err: MsgBox Err.Number & vbCrLf & Err.Description Exit Sub End Sub Function LastNum(InPath As String) As String On Error GoTo LastNum_Err Dim mm As Integer, StrMM As String mm = 0 Do mm = mm + 1 StrMM = Format(mm, "000") ' يفترض في السطر التالي أن عدد الخطابات لن يزيد على 999 خطاب ' في حال كان أكثر من ذلك تعدل الأصفار إلى أربع أصفار ' وكذلك السطر الأخير StrGdNum = Format(MyGdNum, "000") Loop While Dir(InPath & "\" & StrMM & ".doc") <> "" LastNum = Format(mm, "000") Exit Function LastNum_Err: End Function ومرفق الكود واحب انوه اني استفدت من امثلة في المنتدي الاكسس وهذا الكود كود يحتاج تثبيته على قالب النورمال Normal الخطوات : الطريقة الأولى فك ضغط الملف المرفق افتح الوورد أدوات - ماكرو - محرر Visual Basic اضغط الزر اللي بجنب زر مثلث الهندسة واسمه Project Explorer يطلع لك على اليسار قالب النورمال Normal انقر عليه بالزر الايمن واختر Import File يفتح لك نافذة اختيار الملف ، اختر الملف المرفق لك مع هذه المشاركة واسمه Module2.bas الطريقة الثانية فتح الوورد أدوات - ماكرو - محرر Visual Basic اضغط الزر اللي بجنب زر مثلث الهندسة واسمه Project Explorer يطلع لك على اليسار قالب النورمال Normal انقر عليه بالزر الايمن واختر Insert - Module افتح الموديول الجديد وانسخ الكود فيه سواء بالطريقة الاولى او الثانية يتحمل الكود عندك واحسن تسويه له زر أو مفاتيح اختصار طريقة عمل الزر افتح الوورد انقر على أي زر من الأزرار فوق بالزر الايمن اختر تخصيص اختر الاوامر اختر وحدات ماكرو اختر الماكرو : حفظ تقليدي غير شكل الزر زي ما تبغى طريقة مفاتيح الاختصار افتح الوورد انقر على أي زر من الأزرار فوق بالزر الايمن اختر تخصيص اضغط زر لوحة المفاتيح اختر من الفئات وحدات الماكرو واختر الماكرو : حفظ تقليدي اجعل المؤشر في خانة اضغط مفتاح الاختصار الجديد اضغط مفاتيح الاختصار اللي تبغاها تشغل الكود ولا تنسى تختار : حفظ التغييرات في Normal.dot ملاحظاتكم Module2.zip

لك كامل الحرية والا ليش نزلتها هنا وحبذا لو اتحفتنا بالتطويرات

انشي زر جديد وسميه مسابقة جديده وفي حدث عند نقر الزر اكتب DoCmd.SetWarnings False DoCmd.RunSQL "DELETE tbl_Used.* FROM tbl_Used;" DoCmd.SetWarnings True Me.Requery

اخي وحدت الملف بحمد الله لكن يحتاج لتعديلات كثيرة وقبل ما ابدا احب اسال 1- هل تريد يكون اسم الملف الزامي ، يعني اذا كان واصله الارقام الى 4 لا بد يكون الرقم 5 ، او احسن يكون فيه امكانة التغيير. 2- هل المجلد ثابت ما يتغير ، او يستحسن انه يكون فيه امكانية تغير حسب الرغبة. واتمنى لو تطول بالك معي ، لاني ممكن اتاخر عليك شوي

طريقة بدائية جربتها وتمشي إذا ما كان فيه حاجة للحذف هي انك تعمل حقل ترقيم تلقائي في الجدول اسمه مثلا ff القيم الجديدة زيادة وفي خصايص الجدول تكتب في قاعدة التحق من الصحة [ff]<11 نص التحققة من الصحة :عشرة سجلات فقط طبعا ميزتها انها من خصايص الجدول ما تحتاج لنموذج وعيب فيها انها ممكن التعديل فيها للي يقدر يوصل للجدول

هذا مثال مسابقه لا زلت اعمل عليه وناقصه اشيا كثيرة ومقترح عليه شوية تعديلات ما سويتها حتى الحين لكن ممكن تستفيد منه والصراحة انا مسويه لبعض الاصدقا وشارط عليهم انه على الفرغة عشان كذا بالي عليه طويل ارجو انك تقدر تحمله من دون مشاكل http://www.pcpages.com/osama457/Mos22.zip نسخة اضافية تم اضافها فى 25-7-2004 مسابقة.rar

عندي كود قديم جهزته للعمل يبحث عن مجلد بمسار محدد ، وإذا ما هو موجود ينشئه ثم ينظر للملفات الموجودة في المجلد، ويسمي الملف حسب آخر رقم . سأحاول البحث عنه ثم أرفقه هنا .