اذهب الي المحتوي
أوفيسنا

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

  1. ياسر خليل أبو البراء

    ياسر خليل أبو البراء

    المشرفين السابقين


    • نقاط

      21

    • Posts

      13,165


  2. ياسر العربى

    ياسر العربى

    الخبراء


    • نقاط

      16

    • Posts

      1,510


  3. jjafferr

    jjafferr

    أوفيسنا


    • نقاط

      12

    • Posts

      9,814


  4. أبوبسمله

    أبوبسمله

    الخبراء


    • نقاط

      8

    • Posts

      3,254


Popular Content

Showing content with the highest reputation on 15 فبر, 2016 in all areas

  1. السلام عليكم اساتذتي الافاضل ورحمة الله وبركاته احبتي واساتذتي الافاضل ربي يحفظكم جميعا احببت ان اضع عودة الدكتورة ام عهود الله يحميها من كل شر في موضوع خاص لحبنا الشديد لها ولعطائها الكبير ولمساعدتها لكل من يحتاج المساعدة بلا استثناء سائلين المولى عز وعلا ان يحفظها ويحميها من كل شر يارب
    3 points
  2. السلام عليكم اليك رابط فيديو لشرح ذلك .. https://www.youtube.com/watch?v=8JNU7cWg8a4
    3 points
  3. السلام عليكم أخى الفاضل جرب المرفق اماكن.rar
    3 points
  4. 3 points
  5. الأخ الكريم عزيز 60 ... يرجى تغيير رقم 60 في اسم الظهور ليعبر عن اللقب وعن شخصكم الكريم خطوات العمل اللازمة لعمل المطلوب : ************************** اذهب لمحرر الأكواد Alt + F11 اعمل دبل كليك على الفورم .. إذا لم يكن صندوق الأدوات ظاهر قم بإظهاره عن طريق القائمة View ثم الأمر Toolbox اعمل كليك يمين في مكان فارغ داخل صندوق الأدوات ، ستظهر نافذة اختر منها الأداة المسماة Microsoft Web Browser ستظهر الأداة على صندوق الأدوات ، قم بالنقر عليها ورسمها داخل الفورم قم برسم زري اختيار Option Button (عدد 2 أحدهما لاتجاه النص من اليسار لليمين والآخر من اليمين لليسار) ضع الكود التالي في حدث الفورم في البداية Public LeTexte As String, LaCouleur As String, V As Long Private Sub OptionButton1_Click() WebBrowser1.Navigate "about:<html><body BGCOLOR ='#000000' scroll='no'><font color= " & LaCouleur & " size='5' face='arial'><body topmargin='0'>" & "<marquee direction= right>" & LeTexte & " </marquee></font></body><center></html>" End Sub Private Sub OptionButton2_Click() WebBrowser1.Navigate "about:<html><body BGCOLOR ='#000000' scroll='no'><font color= " & LaCouleur & " size='5' face='arial'><body topmargin='0'>" & "<marquee scrollamount=" & V & ">" & LeTexte & "</marquee></font></body><center></html>" End Sub Private Sub UserForm_Initialize() LeTexte = "السلام عليكم و رحمة الله و بركاته&nbsp;&nbsp;&nbsp; &nbsp;" V = 6: LaCouleur = "#OOFFFF": OptionButton1_Click: OptionButton1 = True End Sub تقبل تحياتي
    3 points
  6. السلام عليكم كما خدمتمونا نحن الاعضاء الذين لا نعرف مثل المبدعين وكما تعاونتم معنا وكما افدتمونا وكما رحبتم بنا في هذا الموقع العزيز والغالي على قلوبنا من مدير الموقع ومراقبيه ومشرفيه وخبرائه واعضائه الاعزاء فإنني ولرد قليل من جميل الموقع العزيز قمت بتجميعية من احد المواقع الاجنبية به اكواد جاهزة وبإمكان المحترفين التعديل عليها والاضافة اوالحذف او عمل كود مشابه فيما يرونه مناسبا وكما بإمكان المبتدئين التعلم منها ولا أرجو منكم سوى الدعاء لي بكل ما تريده انت أيها القارئ "واعلم بأنك إن دعوت لي سترد الملائكة اللهم آمين ولك بالمثل " حجم الملف :4.87 MB لذا قمت برفعه على ميديا فاير وان لم يعمل لدى البعض بسبب حجبه في بعض الدول فليخبرنا هنا كي أرفعه على موقع آخر اضغط بارك الله فيك هنا اعتذر لقد تكرر الموضوع مرتين بسبب خللل في تحميل الموقع عندما توقف عملت اعادة تحميل الصفحة فكرر الموضوع مرتين ولا اعرف كيف احذف احدهما
    2 points
  7. السلام عليكم ورحمة الله وبركاته قائمة منسدلة تعتمد على قائمة منسدلة اخرى يمكن استعمال الدالة INDIRECT عن طريق النطاقات المسماة define name ولكن استخدمنا طريقة مختلفة في هذه الحالة اتمنى ان تفيد الجميع المعادلة المستخدمه فى القائمة المنسدلة =OFFSET($A$2;;MATCH($A$6;$A$1:$E$1;0)-1;COUNTA(INDEX($A$2:$E$4;;MATCH($A$6;$A$1:$E$1;0)));) تحميل ملف الاكسيل list.rar
    2 points
  8. إليك أخي الكريم فيديو مبسط لما قدمه أخونا الحبيب أحمد Watch.rar
    2 points
  9. اخى الكريم قف على اخر عمود تريده من فوق ظلله بالكامل ثم كنترول شفت واضغط على سهم الشمال هيتم تحديد باقى الاعمده اعملها اخفاء ثم قف على اخر صف تريده وظلله للاخر ثم كنترول شفت واضغط على السهم لاسفل هيتم تحديد الصفوف للاخر ثم اخفاء للتظليل قف على اسم العمود من فوق خالص وعلى رقم الصف سيتم التظليل بسرعه بدل ما تسحب بالماوس وللاخفاء بعد ما تحدد كليك يمين واخطاؤ اخفاء هذا والله اعلى واعلم ياريت اكون افدتك بالتوفيق
    2 points
  10. جزاكم الله خيراً أخي الحبيب رجب على هذا الحل الرائع إليك حل آخر إثراءً للموضوع ضع الكود التالي في حدث الفورم Private Sub UserForm_Initialize() Dim Rng As Range Dim Dn As Range Dim Dic As Object With Sheets("Sheet1") Set Rng = .Range(.Range("C6"), .Range("C" & Rows.Count).End(xlUp)) End With Set Dic = CreateObject("Scripting.Dictionary") Dic.CompareMode = vbTextCompare For Each Dn In Rng: Dic(Dn.Value) = Empty: Next ComboBox1.List = Application.Transpose(Dic.keys) End Sub Private Sub ComboBox1_Click() Call cValues(ComboBox1.Value, ComboBox2, 4) '4 Is Column Number End Sub Private Sub ComboBox2_Click() Call cValues(ComboBox2.Value, ComboBox3, 5) '5 Is Column Number End Sub Sub cValues(Txt As String, Obj As Object, Col As Integer) Dim Dn As Range Dim Rng As Range Dim Dic As Object Obj.Clear With Sheets("Sheet1") Set Rng = .Range(.Cells(6, Col), .Cells(Rows.Count, Col).End(xlUp)) End With Set Dic = CreateObject("Scripting.Dictionary") Dic.CompareMode = 1 For Each Dn In Rng If Dn.Offset(, -1).Value = Txt Then If Not Dic.exists(Dn.Value) Then Dic(Dn.Value) = Empty End If End If Next Dn Obj.List = Application.Transpose(Dic.keys) End Sub قمت بإعادة تسمية الكومبوبوكس .. بدلاً من Sanf استخدمت الاسم الافتراضي ComboBox1 وبدلاً من Nawa استخدمت ComboBox2 والثالث جعلته بدلاً من ComboBox1 جعلته ComboBox3 .. كما قمت بإزالة الـ Row Source لأول كومبوبوكس .. تم الاستغناء عن الأكواد في حدث ورقة العمل .. فقط الكود في حدث الفورم هو الذي يقوم بالمهمة كاملة إن شاء الله أرجو أن يكون الملف مقبول لديكم تقبل تحياتي Dependent ComboBox On UserForm YasserKhalil.rar
    2 points
  11. السّلام عليكم و رحمة الله و بركاته هل تصدّق حبيبي الغالي يسر خليل أبو البراء أنّي ما قصدت هذا أبدًا .. أحببناك و مازلنا نحبّك و نبقى أوفياء لك و لحبك كأخ في الله .. فكيف للإنسان أن يحاسب أخاه .. هذه لك و تلك لي .. طالما أخذنا منك و مازلنا لحد الآن نعيش و نبني مشاريعنا على أساسك و على أساس أفكارك و أكوادك و بما منّ الله عليك من فضله و علمه جزاك الله خيرًا و زادك من علمه و فضله كل ما في الأمر .. موضوع تناسيته الأحداث فأردت إحيائه و أنت صاحب الفضل في هذا أو ذاك .. ولا أحد بإمكانه أن ينكر جميلك و فضلك علينا فائق إحتراماتي لشخصك الكريم
    2 points
  12. وجب علي الاعتذار أخي الحبيب عبد العزيز البسكري .. فقد نسيت تماماً أنك صاحب الموضوع من البداية ، حيث وجد الملف في مكتبتي الخاصة ولم أذكر صاحب الملف .. فاعذرني حبيبي الغالي عبد العزيز على النسيان تقبل وافر تقديري واحترامي
    2 points
  13. جزاكم الله خيراً أخي العزيز عبد العزيز على هذا الملف اللذيذ .. الذي يحتوي على البهاريز .. تقبل وافر تقديري واحترامي
    2 points
  14. السّلام عليكم و رحمة الله و بركاته الحمد لله الذي بنعمته تتم الصّالحات ألف ألف مبروك .. الانتاج الرائع .. روعة روح أبا يوسف .. و المميّز و الممتاز فائق إعجاباتي
    2 points
  15. تفضل عملت لك طريقتين: الاولى باستخدام الجدول المؤقت tbl_Temp ، والطريقة الثانية عن طريق الكود ووحدة نمطية: . الجزء الاول من الكود لطريقة الجدول المؤقت ، والطريقة الثانية للكود: Function Sort_It() Dim rst As DAO.Recordset Dim rstT As DAO.Recordset 'clear tbl_Temp CurrentDb.Execute ("Delete * From tbl_Temp") 'DoCmd.RunSQL ("Delete * From tbl_Temp") Set rst = CurrentDb.OpenRecordset("Select * From [درجات] Where [Auto_ID]=" & Me.Auto_ID) Set rstT = CurrentDb.OpenRecordset("Select * From tbl_Temp") For ii = 1 To rst.Fields.Count - 1 'MsgBox rst(ii).Name & vbCrLf & rst(ii) rstT.AddNew rstT!iNumber = rst(ii) rstT!iField = rst(ii).Name rstT.Update Next ii 'DoCmd.OpenQuery "qry_Sort_it" Set rst = CurrentDb.OpenRecordset("Select * From tbl_Temp Order By iNumber Desc") rst.MoveLast: rst.MoveFirst Me.L1 = rst!iNumber & vbCrLf & rst!iField rst.MoveNext Me.L2 = rst!iNumber & vbCrLf & rst!iField rst.MoveNext Me.L3 = rst!iNumber & vbCrLf & rst!iField rst.Close: Set rst = Nothing rstT.Close: Set rstT = Nothing End Function Private Sub Form_Current() Call Sort_It Me.L11 = "" Me.L22 = "" Me.L33 = "" Call cmd_Sort_Click End Sub Private Sub cmd_Sort_Click() Dim rst As DAO.Recordset Dim InputArray() As Variant Set rst = CurrentDb.OpenRecordset("Select * From [درجات] Where [Auto_ID]=" & Me.Auto_ID) ReDim InputArray(rst.Fields.Count - 1) 'make the array For ii = 1 To rst.Fields.Count - 1 'MsgBox rst(ii).Name & vbCrLf & rst(ii) InputArray(ii) = rst(ii) Next ii 'call the sorting array Call QSortInPlace(InputArray, , , True) 'display the numbers For ii = 0 To rst.Fields.Count - 2 'then sorted numbers For jj = 0 To rst.Fields.Count - 2 'match the numbers, then display its field name If InputArray(ii) = rst(jj) Then 'MsgBox InputArray(ii) & vbCrLf & rst(jj).Name 'don't repeat the same field name If InStr(Me.L11, rst(jj).Name) > 0 Or InStr(Me.L22, rst(jj).Name) > 0 Then GoTo 2 If Len(Me.L11 & "") = 0 Then Me.L11 = InputArray(ii) & vbCrLf & rst(jj).Name ElseIf Len(Me.L22 & "") = 0 Then Me.L22 = InputArray(ii) & vbCrLf & rst(jj).Name ElseIf Len(Me.L33 & "") = 0 Then Me.L33 = InputArray(ii) & vbCrLf & rst(jj).Name End If End If 2: Next jj Next ii End Sub . واما الوحدة النمطية التي استخدمتها للفرز: Option Compare Database Public Function QSortInPlace( _ ByRef InputArray As Variant, _ Optional ByVal LB As Long = -1&, _ Optional ByVal UB As Long = -1&, _ Optional ByVal Descending As Boolean = False, _ Optional ByVal CompareMode As VbCompareMethod = vbTextCompare, _ Optional ByVal NoAlerts As Boolean = False) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' QSortInPlace ' ' This function sorts the array InputArray in place -- this is, the original array in the ' calling procedure is sorted. It will work with either string data or numeric data. ' It need not sort the entire array. You can sort only part of the array by setting the LB and ' UB parameters to the first (LB) and last (UB) element indexes that you want to sort. ' LB and UB are optional parameters. If omitted LB is set to the LBound of InputArray, and if ' omitted UB is set to the UBound of the InputArray. If you want to sort the entire array, ' omit the LB and UB parameters, or set both to -1, or set LB = LBound(InputArray) and set ' UB to UBound(InputArray). ' ' By default, the sort method is case INSENSTIVE (case doens't matter: "A", "b", "C", "d"). ' To make it case SENSITIVE (case matters: "A" "C" "b" "d"), set the CompareMode argument ' to vbBinaryCompare (=0). If Compare mode is omitted or is any value other than vbBinaryCompare, ' it is assumed to be vbTextCompare and the sorting is done case INSENSITIVE. ' ' The function returns TRUE if the array was successfully sorted or FALSE if an error ' occurred. If an error occurs (e.g., LB > UB), a message box indicating the error is ' displayed. To suppress message boxes, set the NoAlerts parameter to TRUE. ' '''''''''''''''''''''''''''''''''''''' ' MODIFYING THIS CODE: '''''''''''''''''''''''''''''''''''''' ' If you modify this code and you call "Exit Procedure", you MUST decrment the RecursionLevel ' variable. E.g., ' If SomethingThatCausesAnExit Then ' RecursionLevel = RecursionLevel - 1 ' Exit Function ' End If ''''''''''''''''''''''''''''''''''''''' ' ' Note: If you coerce InputArray to a ByVal argument, QSortInPlace will not be ' able to reference the InputArray in the calling procedure and the array will ' not be sorted. ' ' This function uses the following procedures. These are declared as Private procedures ' at the end of this module: ' IsArrayAllocated ' IsSimpleDataType ' IsSimpleNumericType ' QSortCompare ' NumberOfArrayDimensions ' ReverseArrayInPlace ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Temp As Variant Dim Buffer As Variant Dim CurLow As Long Dim CurHigh As Long Dim CurMidpoint As Long Dim Ndx As Long Dim pCompareMode As VbCompareMethod ''''''''''''''''''''''''' ' Set the default result. ''''''''''''''''''''''''' QSortInPlace = False '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This variable is used to determine the level ' of recursion (the function calling itself). ' RecursionLevel is incremented when this procedure ' is called, either initially by a calling procedure ' or recursively by itself. The variable is decremented ' when the procedure exits. We do the input parameter ' validation only when RecursionLevel is 1 (when ' the function is called by another function, not ' when it is called recursively). '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Static RecursionLevel As Long '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Keep track of the recursion level -- that is, how many ' times the procedure has called itself. ' Carry out the validation routines only when this ' procedure is first called. Don't run the ' validations on a recursive call to the ' procedure. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' RecursionLevel = RecursionLevel + 1 If RecursionLevel = 1 Then '''''''''''''''''''''''''''''''''' ' Ensure InputArray is an array. '''''''''''''''''''''''''''''''''' If IsArray(InputArray) = False Then If NoAlerts = False Then MsgBox "The InputArray parameter is not an array." End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' InputArray is not an array. Exit with a False result. ''''''''''''''''''''''''''''''''''''''''''''''''''''''' RecursionLevel = RecursionLevel - 1 Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Test LB and UB. If < 0 then set to LBound and UBound ' of the InputArray. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If LB < 0 Then LB = LBound(InputArray) End If If UB < 0 Then UB = UBound(InputArray) End If Select Case NumberOfArrayDimensions(InputArray) Case 0 '''''''''''''''''''''''''''''''''''''''''' ' Zero dimensions indicates an unallocated ' dynamic array. '''''''''''''''''''''''''''''''''''''''''' If NoAlerts = False Then MsgBox "The InputArray is an empty, unallocated array." End If RecursionLevel = RecursionLevel - 1 Exit Function Case 1 '''''''''''''''''''''''''''''''''''''''''' ' We sort ONLY single dimensional arrays. '''''''''''''''''''''''''''''''''''''''''' Case Else '''''''''''''''''''''''''''''''''''''''''' ' We sort ONLY single dimensional arrays. '''''''''''''''''''''''''''''''''''''''''' If NoAlerts = False Then MsgBox "The InputArray is multi-dimensional." & _ "QSortInPlace works only on single-dimensional arrays." End If RecursionLevel = RecursionLevel - 1 Exit Function End Select ''''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that InputArray is an array of simple data ' types, not other arrays or objects. This tests ' the data type of only the first element of ' InputArray. If InputArray is an array of Variants, ' subsequent data types may not be simple data types ' (e.g., they may be objects or other arrays), and ' this may cause QSortInPlace to fail on the StrComp ' operation. ''''''''''''''''''''''''''''''''''''''''''''''''''' If IsSimpleDataType(InputArray(LBound(InputArray))) = False Then If NoAlerts = False Then MsgBox "InputArray is not an array of simple data types." RecursionLevel = RecursionLevel - 1 Exit Function End If End If '''''''''''''''''''''''''''''''''''''''''''''''''''' ' ensure that the LB parameter is valid. '''''''''''''''''''''''''''''''''''''''''''''''''''' Select Case LB Case Is < LBound(InputArray) If NoAlerts = False Then MsgBox "The LB lower bound parameter is less than the LBound of the InputArray" End If RecursionLevel = RecursionLevel - 1 Exit Function Case Is > UBound(InputArray) If NoAlerts = False Then MsgBox "The LB lower bound parameter is greater than the UBound of the InputArray" End If RecursionLevel = RecursionLevel - 1 Exit Function Case Is > UB If NoAlerts = False Then MsgBox "The LB lower bound parameter is greater than the UB upper bound parameter." End If RecursionLevel = RecursionLevel - 1 Exit Function End Select '''''''''''''''''''''''''''''''''''''''''''''''''''' ' ensure the UB parameter is valid. '''''''''''''''''''''''''''''''''''''''''''''''''''' Select Case UB Case Is > UBound(InputArray) If NoAlerts = False Then MsgBox "The UB upper bound parameter is greater than the upper bound of the InputArray." End If RecursionLevel = RecursionLevel - 1 Exit Function Case Is < LBound(InputArray) If NoAlerts = False Then MsgBox "The UB upper bound parameter is less than the lower bound of the InputArray." End If RecursionLevel = RecursionLevel - 1 Exit Function Case Is < LB If NoAlerts = False Then MsgBox "the UB upper bound parameter is less than the LB lower bound parameter." End If RecursionLevel = RecursionLevel - 1 Exit Function End Select '''''''''''''''''''''''''''''''''''''''''''''''''''''' ' if UB = LB, we have nothing to sort, so get out. '''''''''''''''''''''''''''''''''''''''''''''''''''''' If UB = LB Then QSortInPlace = True RecursionLevel = RecursionLevel - 1 Exit Function End If End If ' RecursionLevel = 1 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that CompareMode is either vbBinaryCompare or ' vbTextCompare. If it is neither, default to vbTextCompare. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If (CompareMode = vbBinaryCompare) Or (CompareMode = vbTextCompare) Then pCompareMode = CompareMode Else pCompareMode = vbTextCompare End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Begin the actual sorting process. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' CurLow = LB CurHigh = UB If LB = 0 Then CurMidpoint = ((LB + UB) \ 2) + 1 Else CurMidpoint = (LB + UB) \ 2 ' note integer division (\) here End If Temp = InputArray(CurMidpoint) Do While (CurLow <= CurHigh) Do While QSortCompare(V1:=InputArray(CurLow), V2:=Temp, CompareMode:=pCompareMode) < 0 CurLow = CurLow + 1 If CurLow = UB Then Exit Do End If Loop Do While QSortCompare(V1:=Temp, V2:=InputArray(CurHigh), CompareMode:=pCompareMode) < 0 CurHigh = CurHigh - 1 If CurHigh = LB Then Exit Do End If Loop If (CurLow <= CurHigh) Then Buffer = InputArray(CurLow) InputArray(CurLow) = InputArray(CurHigh) InputArray(CurHigh) = Buffer CurLow = CurLow + 1 CurHigh = CurHigh - 1 End If Loop If LB < CurHigh Then QSortInPlace InputArray:=InputArray, LB:=LB, UB:=CurHigh, _ Descending:=Descending, CompareMode:=pCompareMode, NoAlerts:=True End If If CurLow < UB Then QSortInPlace InputArray:=InputArray, LB:=CurLow, UB:=UB, _ Descending:=Descending, CompareMode:=pCompareMode, NoAlerts:=True End If ''''''''''''''''''''''''''''''''''''' ' If Descending is True, reverse the ' order of the array, but only if the ' recursion level is 1. ''''''''''''''''''''''''''''''''''''' If Descending = True Then If RecursionLevel = 1 Then ReverseArrayInPlace2 InputArray, LB, UB End If End If RecursionLevel = RecursionLevel - 1 QSortInPlace = True End Function Public Function QSortCompare(V1 As Variant, V2 As Variant, _ Optional CompareMode As VbCompareMethod = vbTextCompare) As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' QSortCompare ' This function is used in QSortInPlace to compare two elements. If ' V1 AND V2 are both numeric data types (integer, long, single, double) ' they are converted to Doubles and compared. If V1 and V2 are BOTH strings ' that contain numeric data, they are converted to Doubles and compared. ' If either V1 or V2 is a string and does NOT contain numeric data, both ' V1 and V2 are converted to Strings and compared with StrComp. ' ' The result is -1 if V1 < V2, ' 0 if V1 = V2 ' 1 if V1 > V2 ' For text comparisons, case sensitivity is controlled by CompareMode. ' If this is vbBinaryCompare, the result is case SENSITIVE. If this ' is omitted or any other value, the result is case INSENSITIVE. ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim D1 As Double Dim D2 As Double Dim S1 As String Dim S2 As String Dim Compare As VbCompareMethod '''''''''''''''''''''''''''''''''''''''''''''''' ' Test CompareMode. Any value other than ' vbBinaryCompare will default to vbTextCompare. '''''''''''''''''''''''''''''''''''''''''''''''' If CompareMode = vbBinaryCompare Or CompareMode = vbTextCompare Then Compare = CompareMode Else Compare = vbTextCompare End If ''''''''''''''''''''''''''''''''''''''''''''''' ' If either V1 or V2 is either an array or ' an Object, raise a error 13 - Type Mismatch. ''''''''''''''''''''''''''''''''''''''''''''''' If IsArray(V1) = True Or IsArray(V2) = True Then Err.Raise 13 Exit Function End If If IsObject(V1) = True Or IsObject(V2) = True Then Err.Raise 13 Exit Function End If If IsSimpleNumericType(V1) = True Then If IsSimpleNumericType(V2) = True Then ''''''''''''''''''''''''''''''''''''' ' If BOTH V1 and V2 are numeric data ' types, then convert to Doubles and ' do an arithmetic compare and ' return the result. ''''''''''''''''''''''''''''''''''''' D1 = CDbl(V1) D2 = CDbl(V2) If D1 = D2 Then QSortCompare = 0 Exit Function End If If D1 < D2 Then QSortCompare = -1 Exit Function End If If D1 > D2 Then QSortCompare = 1 Exit Function End If End If End If '''''''''''''''''''''''''''''''''''''''''''' ' Either V1 or V2 was not numeric data type. ' Test whether BOTH V1 AND V2 are numeric ' strings. If BOTH are numeric, convert to ' Doubles and do a arithmetic comparison. '''''''''''''''''''''''''''''''''''''''''''' If IsNumeric(V1) = True And IsNumeric(V2) = True Then D1 = CDbl(V1) D2 = CDbl(V2) If D1 = D2 Then QSortCompare = 0 Exit Function End If If D1 < D2 Then QSortCompare = -1 Exit Function End If If D1 > D2 Then QSortCompare = 1 Exit Function End If End If '''''''''''''''''''''''''''''''''''''''''''''' ' Either or both V1 and V2 was not numeric ' string. In this case, convert to Strings ' and use StrComp to compare. '''''''''''''''''''''''''''''''''''''''''''''' S1 = CStr(V1) S2 = CStr(V2) QSortCompare = StrComp(S1, S2, Compare) End Function Public Function NumberOfArrayDimensions(Arr As Variant) As Integer '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' NumberOfArrayDimensions ' This function returns the number of dimensions of an array. An unallocated dynamic array ' has 0 dimensions. This condition can also be tested with IsArrayEmpty. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Ndx As Integer Dim Res As Integer On Error Resume Next ' Loop, increasing the dimension index Ndx, until an error occurs. ' An error will occur when Ndx exceeds the number of dimension ' in the array. Return Ndx - 1. Do Ndx = Ndx + 1 Res = UBound(Arr, Ndx) Loop Until Err.Number <> 0 NumberOfArrayDimensions = Ndx - 1 End Function Public Function ReverseArrayInPlace(InputArray As Variant, _ Optional NoAlerts As Boolean = False) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ReverseArrayInPlace ' This procedure reverses the order of an array in place -- this is, the array variable ' in the calling procedure is sorted. An error will occur if InputArray is not an array, 'if it is an empty, unallocated array, or if the number of dimensions is not 1. ' ' NOTE: Before calling the ReverseArrayInPlace procedure, consider if your needs can ' be met by simply reading the existing array in reverse order (Step -1). If so, you can save ' the overhead added to your application by calling this function. ' ' The function returns TRUE if the array was successfully reversed, or FALSE if ' an error occurred. ' ' If an error occurred, a message box is displayed indicating the error. To suppress ' the message box and simply return FALSE, set the NoAlerts parameter to TRUE. ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Temp As Variant Dim Ndx As Long Dim Ndx2 As Long Dim OrigN As Long Dim NewN As Long Dim NewArr() As Variant '''''''''''''''''''''''''''''''' ' Set the default return value. '''''''''''''''''''''''''''''''' ReverseArrayInPlace = False ''''''''''''''''''''''''''''''''' ' Ensure we have an array ''''''''''''''''''''''''''''''''' If IsArray(InputArray) = False Then If NoAlerts = False Then MsgBox "The InputArray parameter is not an array." End If Exit Function End If '''''''''''''''''''''''''''''''''''''' ' Test the number of dimensions of the ' InputArray. If 0, we have an empty, ' unallocated array. Get out with ' an error message. If greater than ' one, we have a multi-dimensional ' array, which is not allowed. Only ' an allocated 1-dimensional array is ' allowed. '''''''''''''''''''''''''''''''''''''' Select Case NumberOfArrayDimensions(InputArray) Case 0 ''''''''''''''''''''''''''''''''''''''''''' ' Zero dimensions indicates an unallocated ' dynamic array. ''''''''''''''''''''''''''''''''''''''''''' If NoAlerts = False Then MsgBox "The input array is an empty, unallocated array." End If Exit Function Case 1 ''''''''''''''''''''''''''''''''''''''''''' ' We can reverse ONLY a single dimensional ' arrray. ''''''''''''''''''''''''''''''''''''''''''' Case Else ''''''''''''''''''''''''''''''''''''''''''' ' We can reverse ONLY a single dimensional ' arrray. ''''''''''''''''''''''''''''''''''''''''''' If NoAlerts = False Then MsgBox "The input array multi-dimensional. ReverseArrayInPlace works only " & _ "on single-dimensional arrays." End If Exit Function End Select ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that we have only simple data types, ' not an array of objects or arrays. ''''''''''''''''''''''''''''''''''''''''''''' If IsSimpleDataType(InputArray(LBound(InputArray))) = False Then If NoAlerts = False Then MsgBox "The input array contains arrays, objects, or other complex data types." & vbCrLf & _ "ReverseArrayInPlace can reverse only arrays of simple data types." Exit Function End If End If ReDim NewArr(LBound(InputArray) To UBound(InputArray)) NewN = UBound(NewArr) For OrigN = LBound(InputArray) To UBound(InputArray) NewArr(NewN) = InputArray(OrigN) NewN = NewN - 1 Next OrigN For NewN = LBound(NewArr) To UBound(NewArr) InputArray(NewN) = NewArr(NewN) Next NewN ReverseArrayInPlace = True End Function Public Function ReverseArrayInPlace2(InputArray As Variant, _ Optional LB As Long = -1, Optional UB As Long = -1, _ Optional NoAlerts As Boolean = False) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ReverseArrayInPlace2 ' This reverses the order of elements in InputArray. To reverse the entire array, omit or ' set to less than 0 the LB and UB parameters. To reverse only part of tbe array, set LB and/or ' UB to the LBound and UBound of the sub array to be reversed. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim N As Long Dim Temp As Variant Dim Ndx As Long Dim Ndx2 As Long Dim OrigN As Long Dim NewN As Long Dim NewArr() As Variant '''''''''''''''''''''''''''''''' ' Set the default return value. '''''''''''''''''''''''''''''''' ReverseArrayInPlace2 = False ''''''''''''''''''''''''''''''''' ' Ensure we have an array ''''''''''''''''''''''''''''''''' If IsArray(InputArray) = False Then If NoAlerts = False Then MsgBox "The InputArray parameter is not an array." End If Exit Function End If '''''''''''''''''''''''''''''''''''''' ' Test the number of dimensions of the ' InputArray. If 0, we have an empty, ' unallocated array. Get out with ' an error message. If greater than ' one, we have a multi-dimensional ' array, which is not allowed. Only ' an allocated 1-dimensional array is ' allowed. '''''''''''''''''''''''''''''''''''''' Select Case NumberOfArrayDimensions(InputArray) Case 0 ''''''''''''''''''''''''''''''''''''''''''' ' Zero dimensions indicates an unallocated ' dynamic array. ''''''''''''''''''''''''''''''''''''''''''' If NoAlerts = False Then MsgBox "The input array is an empty, unallocated array." End If Exit Function Case 1 ''''''''''''''''''''''''''''''''''''''''''' ' We can reverse ONLY a single dimensional ' arrray. ''''''''''''''''''''''''''''''''''''''''''' Case Else ''''''''''''''''''''''''''''''''''''''''''' ' We can reverse ONLY a single dimensional ' arrray. ''''''''''''''''''''''''''''''''''''''''''' If NoAlerts = False Then MsgBox "The input array multi-dimensional. ReverseArrayInPlace works only " & _ "on single-dimensional arrays." End If Exit Function End Select ''''''''''''''''''''''''''''''''''''''''''''' ' Ensure that we have only simple data types, ' not an array of objects or arrays. ''''''''''''''''''''''''''''''''''''''''''''' If IsSimpleDataType(InputArray(LBound(InputArray))) = False Then If NoAlerts = False Then MsgBox "The input array contains arrays, objects, or other complex data types." & vbCrLf & _ "ReverseArrayInPlace can reverse only arrays of simple data types." Exit Function End If End If If LB < 0 Then LB = LBound(InputArray) End If If UB < 0 Then UB = UBound(InputArray) End If For N = LB To (LB + ((UB - LB - 1) \ 2)) Temp = InputArray(N) InputArray(N) = InputArray(UB - (N - LB)) InputArray(UB - (N - LB)) = Temp Next N ReverseArrayInPlace2 = True End Function Public Function IsSimpleNumericType(V As Variant) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' IsSimpleNumericType ' This returns TRUE if V is one of the following data types: ' vbBoolean ' vbByte ' vbCurrency ' vbDate ' vbDecimal ' vbDouble ' vbInteger ' vbLong ' vbSingle ' vbVariant if it contains a numeric value ' It returns FALSE for any other data type, including any array ' or vbEmpty. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If IsSimpleDataType(V) = True Then Select Case VarType(V) Case vbBoolean, _ vbByte, _ vbCurrency, _ vbDate, _ vbDecimal, _ vbDouble, _ vbInteger, _ vbLong, _ vbSingle IsSimpleNumericType = True Case vbVariant If IsNumeric(V) = True Then IsSimpleNumericType = True Else IsSimpleNumericType = False End If Case Else IsSimpleNumericType = False End Select Else IsSimpleNumericType = False End If End Function Public Function IsSimpleDataType(V As Variant) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' IsSimpleDataType ' This function returns TRUE if V is one of the following ' variable types (as returned by the VarType function: ' vbBoolean ' vbByte ' vbCurrency ' vbDate ' vbDecimal ' vbDouble ' vbEmpty ' vbError ' vbInteger ' vbLong ' vbNull ' vbSingle ' vbString ' vbVariant ' ' It returns FALSE if V is any one of the following variable ' types: ' vbArray ' vbDataObject ' vbObject ' vbUserDefinedType ' or if it is an array of any type. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Test if V is an array. We can't just use VarType(V) = vbArray ' because the VarType of an array is vbArray + VarType(type ' of array element). E.g, the VarType of an Array of Longs is ' 8195 = vbArray + vbLong. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If IsArray(V) = True Then IsSimpleDataType = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' We must also explicitly check whether V is an object, rather ' relying on VarType(V) to equal vbObject. The reason is that ' if V is an object and that object has a default proprety, VarType ' returns the data type of the default property. For example, if ' V is an Excel.Range object pointing to cell A1, and A1 contains ' 12345, VarType(V) would return vbDouble, the since Value is ' the default property of an Excel.Range object and the default ' numeric type of Value in Excel is Double. Thus, in order to ' prevent this type of behavior with default properties, we test ' IsObject(V) to see if V is an object. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If IsObject(V) = True Then IsSimpleDataType = False Exit Function End If ''''''''''''''''''''''''''''''''''''' ' Test the value returned by VarType. ''''''''''''''''''''''''''''''''''''' Select Case VarType(V) Case vbArray, vbDataObject, vbObject, vbUserDefinedType ''''''''''''''''''''''' ' not simple data types ''''''''''''''''''''''' IsSimpleDataType = False Case Else '''''''''''''''''''''''''''''''''''' ' otherwise it is a simple data type '''''''''''''''''''''''''''''''''''' IsSimpleDataType = True End Select End Function Public Function IsArrayAllocated(Arr As Variant) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' IsArrayAllocated ' Returns TRUE if the array is allocated (either a static array or a dynamic array that has been ' sized with Redim) or FALSE if the array has not been allocated (a dynamic that has not yet ' been sized with Redim, or a dynamic array that has been Erased). '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim N As Long ''''''''''''''''''''''''''''''''''''''''''''''''''' ' If Arr is not an array, return FALSE and get out. ''''''''''''''''''''''''''''''''''''''''''''''''''' If IsArray(Arr) = False Then IsArrayAllocated = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Try to get the UBound of the array. If the array has not been allocated, ' an error will occur. Test Err.Number to see if an error occured. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next N = UBound(Arr, 1) If Err.Number = 0 Then ''''''''''''''''''''''''''''''''''''' ' No error. Array has been allocated. ''''''''''''''''''''''''''''''''''''' IsArrayAllocated = True Else ''''''''''''''''''''''''''''''''''''' ' Error. Unallocated array. ''''''''''''''''''''''''''''''''''''' IsArrayAllocated = False End If End Function جعفر 281.1جديد.mdb.zip
    2 points
  16. السلام عليكم ورحمة الله وبركاته.. الحمد لله، والصلاة والسلام على رسول الله، وعلى آله وصحبه، وسلم تسليما كثيرا. أما بعد.. الأحبة في صرحنا المبارك.. هذا برنامج لـ (المخازن والحسابات) مع فاتورة للمبيعات، وملحقات خاصة بالحسابات وأرجو أن يكون صالحاً ومفيداً لأغلب الاحتياجات. اسم المستخدم: a كلمة المرور: 123 باسوورد مسح بيانات البرنامج: 123 أوراق العمل: بدون باسوورد محرر الأكواد: بدون باسوورد ..وأسأل الله أن تكون هذه المشاركة نافعة للجميع.. ..وفقني الله وإياكم لما يحب ويرضى.. برنامج المخازن والحسابات.rar
    2 points
  17. اخي الغالي توكل المرفق السابق للكومند بار الخاصة بمحرر الاكود اما قوائم برنامج الاكسيل نفسة 2003 هنا https://support.microsoft.com/en-us/kb/213552 اما اذا كنت حابب تحط اضافة لقوائم 2007 فما فوق للقوائم القديمة فاليك هذا المرفق اما اخي الغالي ابو البراء معرفتي من معرفتك بردو كل اللي اعرفه انه اختصار مثلا بدل ما تكتب مثلا File تكتب 30002 وهكذا ولكن هذا في اوفيس 2003 فما اقل منه يعني مثال Application.CommandBars("Worksheet Menu Bar").Controls("File").Enabled = False ويتم استبداله بالسطر دا Application.CommandBars("Worksheet Menu Bar").FindControl(ID:=30002).Enabled = False اما تطبيق هذه الاكواد على 2007 فيما فوق مجربتش الصراحه تقبلو تحياتي add menu.rar
    2 points
  18. السلام عليكم جرب المعادلة التالية بافتراض ان القيمة فى A1 =INT(A1/3)
    2 points
  19. وعليكم السلام وبعد إذن أخي ابوخليل هنا اجمع جميع الطرق اللي تخطر على بالي ، وهي 4 طرق 1. طريقة أخي ابوخليل: Private Sub Text0_Click() Me.Text0 = Me.Text0.Name End Sub . الطرق الثلاث الباقية تعتمد على الوحدة النمطية: Option Compare Database Function Who_Am_I() Dim frm As Access.Form Dim ctl As Access.Control Set frm = Screen.ActiveForm 'get the active Form Name Set ctl = Screen.ActiveControl 'get the active Control (in our case it was a field) name 'The way we address a Field in another Form, 'like this: Forms!FormName!FieldName 'so we have to do it here similarly, 'this will send the field name to the active Field in the active Form Forms(frm.Name)(ctl.Name) = ctl.Name 'this will return the Funtion Who_Am_I value to the variable that called it Who_Am_I = ctl.Name End Function 2. ننادي الوحدة النمطية مباشرة (لاحظ علامة = ) ، ولا يوجد كود محلي في VBA : . 3. نعمل كود محلي ، والذي ينادي الوحدة النمطية: Private Sub Text4_Click() 'this way will get the field name from the Function Who_Am_I 'and it will place the value in the Field in the Form Call Who_Am_I 'this way will get the field name from the Function Who_Am_I 'and it will place the value in the Field in the Form 'and it WILL place the Field name in the variable A, so that we can use it A = Who_Am_I MsgBox A End Sub . وبما اننا نادينا الوحدة النمطية Who_Am_I عن طريق المتغير A ، فاصبح المتغير A لديه نتيجة/قيمة الوحدة النمطية ، وعليه نستطيع ان نستخدم هذه القيمة كيف نشاء في الكود ، فمثلا استخدمناها لإعطاءنا رسالة بإسم الحقل ، والنتيجة: . 4. نعمل ماكرو ، ونجعل الماكرو ينادي الوحدة النمطية: . (لاحظ مافي علامة = ) ، ولا يوجد كود محلي في VBA: . جعفر 280.db2016.accdb.zip
    2 points
  20. السلام عليكم أخي الشمال قبل ان اضع الحل اعلاه ، فكرت وبحثت كثيرا ، لكن الحلول لم اقتنع بها ، وعلى العموم اليك حلول اثنين: 1. ان تعمل زرين في النموذج ، واحد لمعاينة التقرير (ولا يستطيع المستخدم من خلالها طباعة التقرير لأنه لن يكون فيه رقم وصل) ، وواحد للطباعة مباشرة (وتضع كود رقم الوصل في النموذج ، بحيث يأخذ التقرير رقم الوصل من النموذج) أ- ان لا تسمح للمستخدم ان يطبع التقرير اثناء المعاينة (واليك الصعوبات وخطوات الحل): عند معاينة التقرير ، يستطيع المستخدم ان يطبع التقرير من شريط الادوات عن طريق ايقونة الطباعة ، حتى ولو اخفيت شريط الادوات ولا تُظهر ايقونة الطباعة ، فالمستخدم يستطيع بالنقر على الفأرة باليمين ومن القائمة ان يطبع ، وحتى لو لم اخفيت قائمة النقر بيمين الفأرة ، فالمستتخدم يستطيع ان يضغط على Ctrl + P ويطبع ، فالحل هنا يكون ان: ان تُخفي شريط الادوات ، وان تُخفي قائمة النقر باليمين ، وان تعمل كود يصطاد الضغط على الزر Ctrl فيُلغيه ب- ان تضع صورة مائية على التقرير المعاينة ، تقول فيها مثلا: ان التقرير غير رسمي بغير رقم الوصل ، وهذا الرابط يشرح عمل الصورة المائية: http://www.officena.net/ib/topic/59776-اسئله-عن-التقارير/?do=findComment&comment=387356 2. ان تضع كود خاص بالوندوز (وليس للأكسس) ، بحيث عند اعطاء امر الطباعة ، فنتدخّل ونعطي رقم الوصل ، ثم نسمح للوندوز ان تطبع التقرير جعفر
    2 points
  21. السلام عليكم هذه طريقتي الجدول: . الاستعلام: معادلة Evalفي الاستعلام يجب ان تكون هكذا: 1. اسم الجدول ، 2. اسم الحقل ، 3. الامر IN ، 4. المسمى الذي يظهر لنا في النافذة ، حتى نُدخل في البيانات المطلوبة للمعيار (لاحظ الصورة التي بعد هذه الصورة) . وهذا هو الكود: Eval([tbl_Orders]![Order_No] & " In(" & [Please enter Order Number] & ")") هكذا يجب ان تُدخل المعيار ، وبإستخدام الفاصلة بين الارقام: . والنتيجة: . جعفر 279.More_Than_One_Condition.accdb.zip
    2 points
  22. بسم الله والصلاة والسلام على رسول الله وعلى آله وصحبه ومن والاه أما بعد: السلام عليكم ورحمة الله وبركاته بعد أن وهبني الله الكود المناسب للطباعة السريعة على يد أخي الحبيب وأستاذي الجليل ياسر خليل أبو البراء وبعد وضع كود لتشفير المعادلات للحفاظ عليها من أي خلل لأستاذي الكريم إسلام رجب، فإنني أتشرف بعرض البرنامج عليكم بشكله النهائي حيث نقوم بالخلية J1 بورقة تقرير حركة الصنف بوضع رقم الصنف الأول الذي نرغب طباعته وبالخلية K1 نضع رقم آخر صنف نودّ طباعته ثم نضغط على زر طباعة سريعة وذلك بعد تحديد تاريخي بداية ونهاية التقرير... ليقوم بشكل تلقائي بالتصفية حسب كل صنف ثم الطباعة. "هذا من فضل ربّي" أرجو الله أن يكون عملاً نافعاً نبتغي به وجه الله تعالى ، لأننا فقراء إلى الله تعالى، والله في عون العبد ما كان العبد في عون أخيه تقبلوا تحياتي العطرة والسلام عليكم ورحمة الله وبركاته. برنامج المخازن.rar
    2 points
  23. بالنسبة لمن هو عضو جديد في هذا الموقع لتنزيل الملف اضغط على عبارة "اضغط هنا بارك الله فيك " باللون الأحمر وسيتم تحويل لموقع التنزيل مباشرة في المشاركة الأولى من هذا الموضوع. ولمن تعسر عليه موقع ميديا فاير فقمت برفع الملف الى هذا الموقع وهو جميل وممتاز وعربي ولا يحتاج الى تسجيل للرفع عموما رفعته لك ابو البشر في هذا الموقع الرائع فقط اضغط بارك الله فيك على الرابط التالي http://www.up77.com/C0f95
    2 points
  24. بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته اخوتي / اخواتي لي الشرف ان انظم الى هذا الصرح العلمي ، سائلاً المولى جل وعلا ان يوفقني لما فيه الخير للجميع 🙂 في اول مشاركة لي ، اضع بين يديكم برنامج مسقط التقارير (مسمى صانع التقارير متداول كثيرا ، لذا احببت ان اسمي برنامجي بإسم مميز ، إسم مسقطنا الحبيبة 🙂 ). البرنامج في نسخته الاولى ، لذا ، فلا تتوقعوا الكثير منه 🙂 في احد المشاريع التي عملت عليها قريبا ، كان العمل لسجلات شؤون الموظفين ، ولم يكن بالامكان عمل تقرير محدد ، حيث كانت التقارير المطلوبة من الادارة بشتى انواع البيانات ، طولا وعرضا. لذا اضطررت العمل على صانع للتقارير (في الواقع مسقط التقارير يعتبر برنامجا بحد ذاته ، فالعمل كان ، برنامج في برنامج 🙂 ). مع ان البرنامج بسيط في طريقة عمله (وطبعا عندي الكثير من الاشياء الاخرى التي اود ان اضيفها ، لكن في وقتها ان شاء الله ، وبما ان البرنامج مفتوح المصدر ، فانا ارحب بمن يضيف عليه خصائص جديدة 🙂 ) ، فمع بساطة البرنامج ، إلا ان نتائجه مرضية 🙂 العمل على البرنامج ابسط بكثير من شرحه 🙂 يمكنك نقل هذه الكائنات السته الى برنامجك الخاص ، ومسقط التقارير سيعمل بدون الحاجة الى اي تغيير او كود: مسقط التقارير يعمل على الجداول والاستعلامات فقط ، واليكم طريقة العمل: جدول او استعلام: اختر من ايهم تريد ان تعمل تقريرك ، جدول او استعلام ، الاسم: على اساس الاختيار السابق ، ستظهر لك قائمة بجداولك او استعلاماتك ، وعندما تختار اسم جدول او استعلام ، فان النموذج الفرعي الذي اسفل الاسم سوف يمتلئ باسماء الحقول من الجدول او الاستعلام ، وكلها عليها اشارة اخفي (اي كلها ستكون مخفية من الظهور في النموذج الفرعي الذي بالاسفل) ، احذف اشارة الاخفاء عن الحقول/الخانات التي تريدها ، وستظهر لك في النموذج الفرعي الذي في اسفل النموذج. هذا النموذج هو شكل مبسط من التقرير ، فكما ترى الحقول وعرضها ، وعدد السجلات ، ستراها في التقرير. هناك خطان فوق النموذج الفرعي ، باللون الاصفر والاخضر ، اذا كانت بياناتك اقل من الخط الاصفر ، سيكون التقرير بالطول ، وإلا فانه سيكون بالعرض ، وهناك خطان صفر ، فالمسافة بينهم ستكون للترقيم التلقائي للتقرير (لاحظ ان التقرير لبيانات النموذج ادناه سيكون بالعرض ، لأننا تخطينا الخط الاصفر 🙂 يمكننا ان نمسك الحقول/الخانات بالزر الايسر من الفأرة ونغير ترتيبها يمينا ويسارا ، كما ان البرنامج يحترم عرض الحقل الذي تقوم بتعديله ، (لاحظ ان التقرير لبيانات النموذج سيكون بالطول ، لأننا في حدود الخط الاصفر 🙂 وهذا هو التقرير لبيانات النموذج السابق ، ولاحظ ان البرنامج يقوم بتغيير ارتفاع الصف تلقائيا ، حتى يمكن مشاهدة جميع بيانات الحقل. اذا قررت ان تتعدى الخط الاصفر ، فنفس شروط الخط الاصفر تنطبق على الخط الاخضر ، وهنا نرى باننا اضفنا عنوان لراس صفحة التقرير ، واضفنا معلومات عن موضوع التقرير ، بالاضافة الى معلومات في ذيل التقرير: وهذا هو تقرير لبيانات النموذج السابق ، ولاحظ ان البرنامج يوسع عمود الترقيم التلقائي ليسد المسافة: بعد اختيار الحقول التي نريدها في التقرير ، نستطيع ان نفرز الحقول بالطريقة التي نريد: وكذلك تصفية البيانات حسب الحاجة: وهذا هو تقرير لبيانات النموذج السابق ، لاحظ عدد السجلات قد تغير ، لأني طلبت ان ارى السجلات التي مبالغها اكبر من 500: البرنامج لا يحفظ التقارير (نعم ، عمل طريقة لحفظ اسم لكل تقرير ، على قمة قائمة التحديثات ان شاء الله 🙂 ) ارجوا ان تتقبلوا مني هذا العمل المتواضع 🙂 اسئلة/اقتراحات ، سأحاول الرد على قدر استطاعتي ان شاء الله 🙂 جعفر ملاحظة1: عمود المجموع لا يعمل ، وكان يجب ان اخفيه 😞 ملاحظة2: في الاساس كان عندي كمية كبيرة من صور الشرح ، إلا ان المنتدى لا يسمح بأكثر من 10 مرفقات ، فاختزلت الموضوع 🙂 ملاحظة3: ادراج فيديو لطريقة عمل التقرير: Muscat_Reports.zip
    1 point
  25. اول شئ اشكرك استاذي القدير ياسر خليل ابو البراء . ثاني شئ طبقت الكود الخاص بك وأشتغل وراح اطبقه على ملفي الخاص الاكسل ، ربما تكون المشكلة لانني قمت بتعريف det1 و det2 نوع تاريخ .. على الشكل التالي dim det1 as date dim det2 as date وعندما مسحتهم اشتغل تمام ،، ولكن فوق هذا نسخت الكود الخاص بك ،، لا نه اضمن .. شكراً على حلك السريع .. وربنا يجعلها في ميزان حسانتك أخي الكريم ..
    1 point
  26. دورات اكسيل مجموعة كبيرة من ملفات شرح excel vba ودورات مهمة فى فهم برمجة إكسيل وهذا هو رابط التحميل منقول اضغط هنا للتحميل اليوم اقدم لكم أحسن وأروع كتاب عربي لتعلم برنامج EXCEL يحتوي على شرح مفصل لصيغ والدوال وكذالك مرفق مع الكتاب تطبيقات نموذجية . منقول اضغط هنا للتحميل إن شاء الله تستفادوا منهم بالتوفيق اخوانى الافاضل وبارك الله فى اساتذتنا وجزاهم الله عنا خير الجزاء
    1 point
  27. جزاك الله كل خير اخى ياسر على كلماتك الطيبه نعم الخلان انت تنور اخى حماده وتامر وإن شاء الله تستفاد وتفيدك إخوانك بالتوفيق
    1 point
  28. سلمت يداك اخى خالد وجزاك الله خيرا
    1 point
  29. جرب الكود بهذا الشكل ركز على تحويل التاريخ إلى تسلسل رقمي وليس تاريخ Sub SUMIFS_VBA() Set shName = Sheets("2") LRSH = (shName.Cells(Rows.Count, 15).End(3).Row) det1 = CDbl(#1/1/2016#) det2 = CDbl(Date) stafe = InputBox("ادخل اسم المسوق الذي هو في العمود o ") S = Application.WorksheetFunction.SumIfs( _ shName.Range("B3:B" & LRSH), _ shName.Range("P3:P" & LRSH), ">=" & det1, _ shName.Range("P3:P" & LRSH), "<=" & det2, _ shName.Range("O3:O" & LRSH), stafe) MsgBox (S) End Sub تقبل تحياتي
    1 point
  30. وعليكم السلام ورحمة الله وبركاته أخي وحبيبي في الله عبد العزيز البسكري الفضل لله عزوجل أولاً وأخيراً فيما وصلنا إليه جمعياً ..ثم إن الفضل في هذا الموضوع لك لا ينكر الفضل إلا جاحد أو متكبر (حاشا لله أن نكون من أيٍ منهما) فقط أردت التأكيد على أن الموضوع يخصك في المقام الأول ، حتى ينسب العمل لأهله جمعنا الله وإياك في مستقر رحمته في الملأ الأعلى تقبل وافر تقديري واحترامي
    1 point
  31. المطلوب التسلسل/الفرز تنازليا ، ومن ثم اخذ الارقام الثلاث الاولى ، وليس اكبر قيمة واصغر قيمة جعفر السر في هذا الكود ، وهو تحويل الحقول ، من افقيا ، الى عموديا ، Set rst = CurrentDb.OpenRecordset("Select * From [درجات] Where [Auto_ID]=" & Me.Auto_ID) ReDim InputArray(rst.Fields.Count - 1) 'make the array For ii = 1 To rst.Fields.Count - 1 'MsgBox rst(ii).Name & vbCrLf & rst(ii) InputArray(ii) = rst(ii) Next ii فلما تكون الحقول افقيا ، يجب ان تتعامل مع كل حقل بإسمه ، ولكن عندما تحولهم الى طريقة عمودية ، فيصبح عندك حقل واحد تتعامل معه جعفر
    1 point
  32. لم أجرب الوسط لأنني كنت أنظر في تحديد اسم الحقل لأنني كنت أقوم بمحاولة لإيجاد إجابة ولكني توهت وأيضا في جلب القيمة الوسطى لم استطع التوصل إليها هذه كانت محاولتي الغير مكتملة التي اكتفت على ذكر القيم العليا والدنيا فقط 1جديد------.rar أظن أن الوسط يحتاج للمراجعة
    1 point
  33. السلام عليكم ورحمة الله وبركاته أخي الحبيب عبد العزيز البسكري أنتم الأروع وكلماتكم الأجمل.. لا أقدر على مكافأة كلامكم الطيب وتشجيعكم إلا بقولي جزاكم الله خيرا. . تقبل تحياتي ومحبتي والسلام عليكم ورحمة الله وبركاته
    1 point
  34. حياك الله أخوي عبدالرحمن بس السؤال ، اي الطريقتين صح ، لأن الوسط والاصغر يملكان نفس القيمة ، ولكن اسم الحقل مختلف ، وطبعا السؤال كان في فرز الارقام وليس فرز اسماء الحقول جعفر
    1 point
  35. انا عن نفسي لو Id هيختصر جزئية من الكود ماشي افضله اما اذا كان مجرد تبديل المسمى بالID فالمسميات اكيد هتبقى اسهل في التعامل خصوصا ان الاكواد مش حفظينها اما المسميات فمعروفة للجميع ولا انت شايف ايه؟؟؟؟
    1 point
  36. أخي الفاضل الدهشوري إليك حل بالأكواد (رغم أنك طلبت أن يكون بالمعادلات) .. لعل وعسى أن يكون المطلوب .. وأنا شخصياً أفضل التعامل بالأكواد Sub ExtractData() Dim arrData, arrOut(1 To 1000, 1 To 5), I As Long, P As Long, D1 As Date, D2 As Date, isQualified As Boolean D1 = ورقة2.Range("E2").Value D2 = ورقة2.Range("H2").Value With ورقة1 arrData = .Range("A1:H" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value For I = 1 To UBound(arrData, 1) If arrData(I, 1) = "التاريخ:" Then If arrData(I, 2) >= D1 And arrData(I, 2) <= D2 Then P = P + 1 arrOut(P, 1) = arrData(I, 7) arrOut(P, 5) = arrData(I, 2) isQualified = True Else isQualified = False End If End If If arrData(I, 1) = "إجمالى" And isQualified Then arrOut(P, 2) = arrData(I, 2) Next I End With ورقة2.Range("B5").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut End Sub تقبل تحياتي كشف حساب.rar
    1 point
  37. جزاك الله خير وجعلة في ميزان حساناتك اشكرك جزيل الشكر صراحة مبدع لك كل الاحترام والتقدير سلمت اناملك الذهبية
    1 point
  38. احسنت : تم تنفيذ الخطواط بنجاح مشكور شرح جيد
    1 point
  39. جزاكم الله خيراً أخي الفاضل محمد عادل تقبل وافر تقديري واحترامي
    1 point
  40. sumproductشرح لبعض استخدامات الداله sum product.rar
    1 point
  41. أخي الكريم محمد عادل بارك الله فيك وجزاك الله كل خير على هذه الموضوعات الممتعة والمفيدة واصل بلا فواصل تقبل تحياتي
    1 point
  42. شكرا لك اخي العزيز ( ابو البراء ) للتوضيح ... قد غير الاسم ورفقت الصور وتشرفت بمعرفتكم اخ عزيزاً وبجميع الاخوة
    1 point
  43. قم بضغط الملف ورفعه على موقع خارجي إذا تعذر إرفاق الملف هاهنا
    1 point
  44. أخي الكريم ابن الملك لم أطلع على الملف ولكن أعتقد أن ib متغير من النوع Boolean وهو يحمل إما القيمة True أو False ، فعند ذكر الشرط If ib then فإنه يفهم عندما تكون القيمة True يتم تنفيذ التالي بالنسبة لجملة Seelct Case فدي جملة شرطية ..يتم اختبار قيمة الخلية Cells(R,3) في الصف المجهول اللي في الحلقة التكرارية في العمود الثالث ..سيكون التعامل مع الشرط بين التاريخين dt1 و dt2 ... أرجو أن أكون وفقت في توصيل المعلومة
    1 point
  45. أخي الكريم أهلاً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور للغة العربية كما يرجى الإطلاع على التوجيهات في الموضوعات المثبتة في المنتدى لمعرفة كيفية التعامل بشكل أفضل مع المنتدى الموضوع بسيط ولا يحتاج لمساعدة فقط افتح ملف إكسيل وفي الخلية A1 ضع كلمة رقم مسلسل ، وفي الخلية المجاورة B1 ضع كلمة الاسم وفي الخلية التي تليها C1 ضع كلمة اسم الأم ..وهكذا إلى حيث تريد من الأعمدة ويمكنك الإضافة لقاعدة البيانات بكل سهولة كما يمكنك حذف الصفوف في حالة رغبت في ذلك بكل سهولة .. إذا تعثر عليك الأمر أبلغنا فيما تعثرت فيه وإن شاء الله ستجد من يقدم لك يد المساعدة إليك مثال مبسط يمكنك التعلم منه كبداية تقبل تحياتي UserForm Data Entry TextBox.rar
    1 point
  46. جزاك الله خير اخي عبد العزيز ودائما في تقدم تقبل تحياتي
    1 point
  47. سادساً :- التعامل مع العناصر الموجوده داخل الــ Frame بطرق احترافيه فى البدايه يبدو ان العنوان غريب وغير مفهوم خليك معايا خطوه خطوه هتفم يعنى ايه الكلام ده شاهد الصوره التاليه دا فورم فى مرحلة التصميم وزى ما انتم شايفين يوجد زر اخضر اسمه Test وهو عباره عن Label ويوجد ايضا عدد 2 تكست بوكس وعدد 2 كمبو بوكس المطلوب انا عايز اعمل كود عند الضغط على الزر الاخضر اثناء عمل الفورم يقوم الكود بعمل اختبار للعناصراللى من النوع تكست بوكس هل هى فارغه ام بها بيانات اذا كانت فارغه يعطينى رساله باسم التكست وكمان يجعل لون التكست احمر ازاى ننفذ الكلام ده اولا هو عايز الكود يتم تنفيذه عند الضغط على الزر الاخضر حلو اوى طيب الزر الاخضر ده عباره عن ايه ؟ شوف الصوره هتلاقى ان الخاصيه Name هى Label1 اذن الكود هيكون كالتالى Private Sub Label1_Click() 'مكان وضع الكود المراد تنفيذه End Sub ما هو الكود المراد تنفيذه ؟ هو اختبار العناصر هل هى من النوع تكست بوكس أم لا واذا كانت من النوع تكست بوكس هل هى بها بيانات ام لا واذا تبين ان العنصر من نوع التكست بوكس ولا يوجد به بيانات اظهرلى رساله باسم العنصر وكمان اجعل العنصر لونه احمر أول شئ علشان اختبر كل العناصر اللى على الفورم واشوف نوعها اذن لازم اعرف متغير من نوع Control لان انا هتعامل مع العناصر Dim a As Control هنا سميت المتغير اسم a ( وطبعا يمكن تسمية اى اسم كيفا شئت ) وقلت اى المتغير a ده عباره عن عنصر تحكم ( قد يكون لليبل او تكست بوكس او كمبوبوكس او ليست بوكس او فريم او تشيك بوكس وغيرها من العناصر ) فعلشان الف على كل العناصر اللى موجوده على الفورم يبقى لازم الحلقه التكراريه For Each Private Sub Label1_Click() Dim a As Control For Each a In Me.Controls ' مكان اختبار العنصر اذا كان من النوع تكست بوكس وايضا هل هو فارغ من البيانات Next a End Sub عملت حلقه For Each للمتغير a وقلت ان a ده هو عباره عن عنصر تحكم موجود على الفورم Me.Controls Me هنا عايده على عناصر الفورم ازاى بقى اعمل اختبار للعناصر هل هى من النوع تكست بوكس و هل هى بها بيانات ام لا اذن هستخدم if Then If TypeOf a Is msForms.TextBox And a = "" Then End If if تعنى لو الاختبار الاول هل العنصر من نوع التكست بوكس TypeOf a Is msForms.TextBox TypeOf تعنى نوع الــ a هو عنصر التحكم اللى بيتغير كل مره مع الحلقه For Each is يكون msForms.TextBox تكست بوكس الاختبار الثانى a = "" and تعنى ( و ) لعمل شرط ثانى a = "" عنصر التحكم فارغ Then تعنى نفذ التالى ( وطبعا قفلنا if بــ End if ) طيب لما الكود يختبر نوع العنصر ويلاقيه تكست بوكس وكمان يلاقيه فارغ ماذا ينفذ يجعل التكست بوكس لون الخلفيه احمر ويظهر لى رساله باسم العنصر If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 MsgBox "فارغ يرجى تعبئة التكست" & a.Name End If شاهد الكود بشكله النهائى Private Sub Label1_Click() Dim a As Control For Each a In Me.Controls If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 MsgBox "فارغ يرجى تعبئة التكست" & a.Name End If Next a End Sub هعملك مشهد تمثيلى لعمل الكود جوا دراما يعنى جايز الاقى فيكم مخرج يكتشفنى عند عمل الكود فى اول سطر هيخزن فى ذاكرته ان المتغير a هو عنصر تحكم ثم ياتى للسطر الثانى وهو For Each a In Me.Controls الحلقه هتجعل ان a هى Label1 هيروح للسطر اللى بعده يعمل اختبار بالــ if فهيلاقى ان a اللى هى دلوقتى ( Label1) مش من النوع تكست بوكس اذن متحققش الشرط الاول فهينتقل الى End if بدون ما ينفذ اى شئ ثم ينتقل الى Next وتعنى ارجع الى الحلقه For Each مره تانية لما يرجع للحلقه سيكون a فى هذه المره هى TextBox1 ثم ينتقل الى السطر التالى اختبار if طبعا هيختبر نوع TextBox1 هيلاقيه بالفعل من النوع TextBox تحقق اول شرط طيب هيشوف الشرط التانى هل التكست فارغ ام به بيانات اذا كان فارغ هيجعل لون خلفيته حمراء ويعطنى رساله باسمه ثم ينتقل الى Next وتعنى ارجع الى الحلقه For Each مره تانية لما يرجع للحلقه سيكون a فى هذه المره هى ComboBox1 ثم ينتقل الى السطر التالى اختبار if طبعا هيختبر نوع ComboBox1 هيلاقيه مش من النوع ComboBox فلم يتحقق الشرط الاول فهينتقل الى End if بدون ما ينفذ اى شئ ثم ينتقل الى Next وتعنى ارجع الى الحلقه For Each مره تانية وهكذا الى ان تنتهى الحلقه بعد ما تجعل a بكل العناصر اللى على الفورم وينتهى الكود شاهد هذه الصوره عند عمل الفورم والضغط على الزر الاخضر دى كانت مقدمه للمثال التالى وهو الاهم واللى اكيد هيقابلك لو انت هتصمم برامج اكيد هيقابلك المثال التالى مثال 2 :- شاهد الصوره التالية طبعا علشان اعمل كود فى حدث الليبل " الحفظ " هيكون الاعلان عن الكود كالتالى Private Sub Label1_Click() 'اولا اختبار صحة الادخالات 'ثانيا ترحيل البيانات التى تم تعبئتها من قبل المستخدم الى الشيت End Sub انا موضوعى اليوم هو اولا اختبار صحة البيانات المدخله أما الجزء الخاص بترحيل البيانات الى الشيت مش موضوعى اليوم سنتناوله لاحقا باذن الله اولا اختبار صحة البيانات المدخله لو رجعت للصوره السابقه هتلاقى ان المطلوب اختبار كل عناصر التكست بوكس هل تم ملئ الدرجات بها ام لا وزى ما عرفنا قبل كدا ممكن تكون كالتالى Private Sub Label1_Click() If TextBox1 = "" Then TextBox1 .BackColor = 10200 End If If TextBox2 = "" Then TextBox2 .BackColor = 10200 End If End Sub يعنى هختبر كل عنصر بالشكل ده طبعا مستحيل طيب هتعمل ايه لو كان عندك مثلا 100 تكست بوكس او اكتر ؟؟؟؟؟؟ طبعا لو عملت كدا محتاج 100 صفحه علشان تكتب الكود مش منطق طبعا اذن لازم من حل احترافى شاهد الكود بشكل احترافى فى بضعه اسطر وبعدين نشرحه Private Sub Label1_Click() Dim a As Control For Each a In Frame1.Controls If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 End If If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then a.BackColor = 10200 End If End If Next a 'ثانيا كود ترحيل البيانات التى تم تعبئتها من قبل المستخدم الى الشيت End Sub الكود فى المثال السابق كانت حلقة For Each عباره عن For Each a In Me.Controls ( هنا كان المتغير a يمثل كل العناصر على الفورم لذالك استخدمت Me.Controls وقلت ان Me عائده على الفورم النشط لكن فى الكود الحالى انا عايز اتعامل مع العناصر اللى داخل الــ Frame1 فقط فتم كتابة الحلقه كالتالى عباره عن For Each a In Frame1.Controls فهنا a هتكون كل عنصر من العناصر اللى داخل الفريم فقط واحد صاحى معايا هيلاحظ ان لما استخدمت If لاختبار ان العنصر من النوع تكست بوكس تم استخدام شرط التحقق من نوع العنصر انه تكست بوكس وشرط ان العنصر فارغ فى سطر واحد من خلال And شاهد الكود If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 End If ولكن عند استخدام if لاختبار ان العنصر من النوع كمبوبوكس وان الاختيار تم من القائمه تم استخدام if لاختبار شرط التحقق من نوع العنصر اذا كان كمبوبوكس يتم تنفيذ if اخرى وكتابة الشرط الثانى ان الاختيار تم من القائمه شاهد الكود If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then a.BackColor = 10200 End If End If فى حد عنده تفسير لذالك ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟ ليه مكتبناش اختبار ان نوع العنصر كمبوبوكس وان الاختيار تم من القائمة فى سطر واحد من خلال And مثل التكست بوكس يعنى يكون كدا If TypeOf a Is msForms.ComboBox And a.MatchFound = False Then a.BackColor = 10200 End If هقولك انا ما هو السبب الحلقه For Each لما تشتغل هيكون اول مره a كل مره تمثل عنصر من عناصر التحكم داخل الفريم فهيكون أما ليبل أو تكست بوكس أو كمبوبوكس كما هو بمثالنا فى الصوره السابقه موضوع الشرح لما تشتغل If الاولى If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 End If فعندما يكون a عباره عن Label " " = a " " =Label1 فلا يوجد مشكله لان Label ممكن = فارغ -------------------------------------- فعندما يكون a عباره عن TextBox " " = a " " =TextBox1 فلا يوجد مشكله لان TextBoxممكن = فارغ -------------------------------------- فعندما يكون a عباره عن ComboBox " " = a " " =ComboBox1 فلا يوجد مشكله لان ComboBox ممكن = فارغ -------------------------------------- لما تشتغل If الثانيه If TypeOf a Is msForms.ComboBox And a.MatchFound = False Then a.BackColor = 10200 End If فعندما يكون a عباره عن Label a.MatchFound = False Label.MatchFound = False فهنا يوجد مشكله لان Label ليس من خواصه MatchFound وكذالك TextBox لان MatchFound هى من خواص ComboBox فقط وهى لعمل اختبار هل الاختيار تم من القائمه ام لا لذالك مينفعش نعمل الكود بالشكل ده هيحدث Error ولتجنب Error لازم يكون الكود بالشكل التالى If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then a.BackColor = 10200 End If End If يعنى اختبر العنصر هل هو ComboBox أولا أم لا اذا كان من النوع ComboBox اعمل اختبار عليه وهو هل تم الاختيار من القائمه أم لا واذا كان العنصر من النوع Label أو TextBox متعملش اختبار MatchFound ارجوا ان يكون الشرح واضح هو بس محتاج تركيز شويه شاهد الكود مره تانية بشكله النهائى كالتالى Private Sub Label1_Click() Dim a As Control For Each a In Frame1.Controls If TypeOf a Is msForms.TextBox And a = "" Then a.BackColor = 10200 End If If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then a.BackColor = 10200 End If End If Next a 'ثانيا كود ترحيل البيانات التى تم تعبئتها من قبل المستخدم الى الشيت End Sub شاهد الصوره التاليه عند تشغل الفورم والضغط على زر الحفظ طبعا انت ممكن تغير فى الكود بدل ما ينفذ بجعل الخلفيه لونها احمر a.BackColor = 10200 ممكن تغير اى شئ تريد تنفيذه يعنى مثلا يعطى للمستخدم رساله باسم العنصر اللى فيه خطأ زى كدا Private Sub Label1_Click() Dim a As Control For Each a In Frame1.Controls If TypeOf a Is msForms.TextBox And a = "" Then MsgBox a.Name & " برجاء تعبئة بيانات" End If If TypeOf a Is msForms.ComboBox Then If a.MatchFound = False Then MsgBox a.Name & " برجاء تعبئة بيانات" End If End If Next a 'ثانيا كود ترحيل البيانات التى تم تعبئتها من قبل المستخدم الى الشيت End Sub شاهد الصوره التاليه عند تشغل الفورم والضغط على زر الحفظ ------------------------------------------------------------------------------------------------------------------------------------ الى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد انتظرونا تقبلوا تحياتى
    1 point
  48. وعليكم السلام الطريقة التي انا عملتها هي كالتالي: التقرير ، عملت الوجهين على نفس الورقة ، الواجهة على الجهة اليسار ، والخلفية على الجهه اليمنى: . والصورة النهائية هكذا: . وعند الانتهاء من طباعة جميع البطاقات ، وتقطيع كل بطاقة على حدة (كما في الصورة اعلاه) ، ثم تقوم بثني البطاقة ، بحيث تصبح البطاقة لها واجهة وخلفية ، ثم تقوم بوضعها في الكيس البلاستيك ، وتغلفها حراريا جعفر
    1 point
×
×
  • اضف...

Important Information