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

العفو اخي الكريم اتشرف بخدمتك في اي وقت

اذا كان النموذج مرتبط مباشرة بالجدول استخدم التالي DoCmd.GoToRecord , , acNewRec لكن اذا لم يكن مرتبط بجدول استخدم التالي قبل استدعاء البيانات [اسم عنصر التحكم أو مربع النص]=Null

تفضل هذا التعديل DATA200012.rar

من مبدأ تعدد الحلول اضافة لما اشار الية الدكتور الفاضل حسنين اذا كنت تستخدم احد الاصدارات الحديثة اكسس مممكن عملها في الجدول مباشرة عن طريق جعل حقل الجنس محسوب وتكون قيمة الحقل تساوي 👇 IIf(Left([الرقم_الوطني];2)=10;"ذكر";IIf(Left([الرقم_الوطني];2)=11;"انثى";"رقم غير صحيح")) وتفسيره اذا كان الرقمين من اليسار تساوي 10 الجنس ذكر واذا كان الرقمين تساوي 11 الجنس انثى واي رقم اخر يكون الرقم الوطني او التعريفي غير صحيح وكررنا دالة iif لكونها تعود بنتيجين ونحن نحتاج الى نتيجة ثالثة لو كان الرقم لا يساوي 11 او 10 مرفق مثال ذكروانثى.accdb

جزاك الله خيرا .. ممنونك اخي

تفضل اخي الكريم ملئ بشرط.xlsm

فعلا صحيح تفضل هذا التعديل DATA200011.zip

عليكم السلام، تفضل: Public Function startsWith(str As String, prefix As String) As Boolean startsWith = Left(str, Len(prefix)) = prefix End Function Private Sub cmd_checkGender_Click() Dim vCheckGender As Boolean Dim vGenderStr As String vGender = startsWith("Here Your Number Student", "10") If vGender = True Then vGenderStr = "ÐßÑ" Else vGenderStr = "ÃäËì" End If MsgBox vGenderStr End Sub استبدل العبارة ( Here Your Number Student ) برقم الطالب.

المطلوب غير واضح عن ماذا تريد البحث؟؟؟ و ما هي النتائج المطلوبة؟؟؟

طيب تمام جرب هذا التعديل DATA200010.rar

اردت الاعتذار عن المتابعة بهذا الملف ااسبب التالي في اول مشاركة لك من خلال العبارة التي كتبتها: *** فإذا كان الموظف لديه بند مثلا راتب اساسي ، بدل سكن ، اجمالي الاستحقاق ( هذه ثلاثةبنود ) فإن الموظف سينقل ويكرر ثلاث مرات في الصفوف، بحيث يكون مقابل كل اسم لهذا الموظف البند والمبلغ الخاص به. والان تريد *** اسماء الموظفين في الصفوف لا يمكن تتكرر. بمعنى لا يمكن ان يتكرر اسم الموظف في اكثر من صف لكن بما هي المرة الأولى تم التعديل على الماكرو لبعمل كما تريد الماكرو الجديد (العمل في صفحة Salim ) Sub Enplyee_Data() Dim Target_sheet As Worksheet Dim SA As Worksheet Dim RO%, ROS%, i%, n% Dim How_many%, m%, t%, x% Dim Data As Range Dim Dic As Object, Ky Dim arr_Band(), arr_Num() Application.ScreenUpdating = False Set Target_sheet = Sheets("Salim") Set SA = Sheets("Salary") RO = Target_sheet.Cells(Rows.Count, 1).End(3).Row If RO > 2 Then Target_sheet.Range("A3:H" & RO + 2).Clear End If ROS = SA.Cells(Rows.Count, 1).End(3).Row Set Dic = CreateObject("Scripting.Dictionary") For i = 4 To ROS If SA.Cells(i, 6) <> "" Then Dic(SA.Cells(i, 6).Value) = "" End If Next i If Dic.Count Then m = 3 For Each Ky In Dic.keys n = Application.Match(Ky, SA.Range("f4:f" & ROS), 0) + 3 How_many = Application.CountA(SA.Range("H" & n).Resize(, 60)) Target_sheet.Range("A" & m).Resize(How_many, 6).Value = _ SA.Range("a" & n).Resize(, 6).Value m = m + How_many + 1 Next Ky For x = 3 To m - 2 If Application.CountIf(Target_sheet.Range("F3:F" & x), Target_sheet.Range("F" & x)) = 1 Then n = Application.Match(Target_sheet.Range("F" & x), SA.Range("f4:f" & ROS), 0) + 3 For y = 8 To 67 If SA.Cells(n, y) <> "" Then ReDim Preserve arr_Band(t) arr_Band(t) = SA.Cells(3, y) ReDim Preserve arr_Num(t) arr_Num(t) = SA.Cells(n, y) t = t + 1 End If Next y End If '<> "" If t > 0 Then Target_sheet.Range("G" & x).Resize(t) = _ Application.Transpose(arr_Band) Target_sheet.Range("H" & x).Resize(t) = _ Application.Transpose(arr_Num) End If 't>0 t = 0: Erase arr_Num: Erase arr_Num Next x End If RO = Target_sheet.Cells(Rows.Count, 1).End(3).Row t = 3 If RO > 2 Then For n = 3 To RO + 1 If Target_sheet.Cells(n, 1) = "" Then Target_sheet.Cells(n, "F") = "Sum Of " & Target_sheet.Cells(n - 1, "F") Target_sheet.Cells(n, "F").Resize(, 2).Merge Target_sheet.Cells(n, "H").Formula = _ "=SUM(H" & t & ":H" & n - 1 & ")" t = n + 1 End If Next Target_sheet.Cells(n, "F") = "Sum Of All " Target_sheet.Cells(n, "H").Formula = _ "=SUM(H3:H" & n - 1 & ")/2" Target_sheet.Cells(n, "F").Resize(, 2).Merge With Target_sheet.Range("A3:H" & n) .Font.Size = 14 .Font.Bold = True .Borders.LineStyle = 1 .InsertIndent 1 .Interior.ColorIndex = 35 .Value = .Value .Columns(8).NumberFormat = "#,##0" End With For n = 3 To RO + 1 If Target_sheet.Cells(n, 1) = "" Then Target_sheet.Cells(n, 1).Resize(, 8). _ Interior.ColorIndex = 28 End If Next Target_sheet.Cells(n, 1).Resize(, 8). _ Interior.ColorIndex = 40 End If Application.ScreenUpdating = True End Sub '++++++++++++++++++++++++++++++++ الملف مرفق RAWATEB_ADVANCED.xlsm

السلام عليكم ورحمة الله اخى الكريم لقد فهمت من المشاركة الاولى انك تريد اضافة ورقة لكل موظف ومن ثم اضافة البيانات التى تخصه فقط فى تلك الورقة ان كان فهمى هذا صحيحا فيمكنك استخدام الكودين الاتيين الاول لاضافة ورقة جديدة لاى موظف جديد و الثانى لترحيل البيانات الخاصة به الى ورقته اليك الكود الاول يربط الزر الخاص بتنفيذ الكود بالكود الثانى Sub CreateAcc() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, Rng As Range, C As Range Set ws = Sheets("Salary04 (2)") LR = ws.Range("F" & Rows.Count).End(3).Row Set Rng = ws.Range("F3:F" & LR) On Error Resume Next For Each C In Rng If Len(Trim(C.Value)) > 0 Then If Len(Worksheets(C.Value).Name) = 0 Then Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = C.Value End If End If With Sheets(C.Value) .Range("A2:H2") = Array("التسلسل", "رقم المركز", "رقم الموظف", _ "الشهر", "السنة", "اسم الموظف", "البند", "المبلغ") .Range("A2:H2").Font.Size = 14 .Range("A2:H2").Font.Bold = True .Range("A2:H2").Columns.AutoFit End With Next End Sub الكود الثانى ويتم ربطه بالزر Sub TrData() Dim i As Long, wd As Worksheet Dim C As Range, Sh As Worksheet Set wd = Sheets("Salary04 (2)") CreateAcc For Each C In wd.Range("F3:F" & wd.Range("F" & Rows.Count).End(3).Row) x = C.Row i = 7 Do While i <= 100 If wd.Cells(x, i) <> "" Then p = p + 1 With Sheets(C.Value) .Cells(p + 2, 1) = wd.Cells(x, 1) .Cells(p + 2, 2) = wd.Cells(x, 2) .Cells(p + 2, 3) = wd.Cells(x, 3) .Cells(p + 2, 4) = wd.Cells(x, 4) .Cells(p + 2, 5) = wd.Cells(x, 5) .Cells(p + 2, 6) = wd.Cells(x, 6) .Cells(p + 2, 7) = wd.Cells(2, i) .Cells(p + 2, 8) = wd.Cells(x, i) .Range("A2:H" & p + 2).Columns.AutoFit .Range("A2:H" & p + 2).Font.Bold = True .Range("A2:H" & p + 2).Font.Size = 14 .Range("A2:H" & p + 2).Borders.LineStyle = 1 End With End If i = i + 1 Loop p = 0 Next End Sub

تفضل التعديل الترقيات.zip

جرب هذا الكود Option Explicit Sub hid_all() Dim My_num As Single Dim Col As Single Col = Application.Columns.Count Range("B1").Resize(, Col - 1).Columns.Hidden = True If Val(Range("A1")) <= 0 Then My_num = 1 Else My_num = Int(Range("A1")) End If Range("A1") = My_num Range("A1").Resize(, My_num).Columns.Hidden = False End Sub '++++++++++++++++++++++ Sub show_all() Dim Col As Single Col = Application.Columns.Count Range("b1").Resize(, Col - 1).Columns.Hidden = False End Sub الملف مرفق Show_hide_colomns.xlsm

Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim x, lr, C Dim ws As Worksheet Set ws = Sheets("بيانات") With ws lr = .Cells(Rows.Count, "a").End(xlUp).Row If Not Intersect(Target, Range("a2:a10000")) Is Nothing Then For x = 2 To lr If Target.Text = .Cells(x, 1).Text Then C = .Cells(x, Columns.Count).End(xlToLeft).Column Range("a1").Resize(, C).Value = .Range("a1").Resize(, C).Value Target.Offset(, 1).Resize(, C).Value = .Cells(x, 2).Resize(, C).Value ' Target.Offset(, 2).Value = .Cells(x, 6).Value ' Target.Offset(, 3).Value = .Cells(x, 7).Value ' Target.Offset(, 4).Value = .Cells(x, 8).Value Exit For End If Next x End If End With End Sub عدل اسم الشيت ان لم يعمل

وعليكم السلام ورحمة الله وبركاته اذا كنت تريد حقل اسفل التقرير يظهر اجمالي " تم الدفع " واجمالي " لم يتم الدفع " سيكون كالتالي 1 - تم الدقع =Sum(IIf([حالة الدفع]="تم الدفع";[قيمة القسط];0)) 2 - لم يتم الدفع =Sum(IIf([حالة الدفع]="لم يتم الدفع";[قيمة القسط];0)) الاقساط.rar تحياتي

هذه وحدة نمطية لإخفاء وإظهار ملف معين مهما كان نوعه وايضا ضمن موقع قاعدة البيانات الافتراضي Sub HideUnhideFile(pstrFilespec As String, pblnShowFile As Boolean) Dim FS As Object Dim F As Object Set FS = CreateObject("Scripting.FileSystemObject") Set F = FS.GetFile(pstrFilespec) If pblnShowFile Then F.Attributes = F.Attributes And (Not vbHidden) Else F.Attributes = F.Attributes Or vbHidden End If End Sub Private Sub CommandHide_Click() HideUnhideFile (CurrentProject.Path & "\kk.jpg"), False End Sub Private Sub CommandShow_Click() HideUnhideFile (CurrentProject.Path & "\kk.jpg"), True End Sub وهذا اقصر كود يمكنه القيام بالعملية هذا للإخفاء : Shell "attrib +h D:\xx.jpg" وهذا للإظهار : Shell "attrib -h D:\xx.jpg" علما ان الأفضل هو جعل الملفات المهمة ضمن مجلد واحد وتطبيق الفكرة على المجلد

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

وعليكم السلام ورحمة الله وبركاته ينقصها جدول اساسيات المدرسة، (الثوابت) وانا افضل ان تكون كل المسميات باللغة الانجليزية ولو انجليزي معرب - بيانات الطلاب: StuTbl > للربط يجب ان يحتوي على حقل مفتاح اساسي بترقيم تلقائي: رقم_الطالب وحقل class_id رقم. - الصفوف: classTbl > للربط يجب ان يحتوي على مفتاح اساسي رقم class_Id - المواد الدراسية : SubTbl > للربط يجب ان يحتوي على مفتاح اساسي رقم sub_id - ثوابت المدرسة: BasicTbl للربط يجب ان يحتوي على مفتاح اساسي رقم bas_id - علامات الطلاب: StuMArks للربط يجب ان يحتوي على حقل رقم_الطالب بتنسيق رقم بدون وليس شرطا ان يكون اساسي - واخيراً الجدول المؤقت: TempTbl هذا الحقل هو نسخة شاملة لكل البيانات التي سيتم استيرادها ولا يهم نأتي الى ربط الجداول: يتم ربط بيانات الطلاب مع العلامات. يتم ربط الصفوف في بيانات الطلاب. يتم ربط المواد الدراسية بالصفوف. :: دعنا نبدأ خطوة خطوة وسوف تحصل على برنامج يلبي كل احتياجاتك :: كل عام وانتم بخير ::

الفيديو الثاني