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

لدينا جدول يحتوي على اسماء التلاميذ مع علاماتهم بشكل عامودي المطلوب تحويله الى جدول مطاطي مع جمع العلامات الملف الرفق بوضح كل شيء Tanspose_notes.xlsm

تفضل . جعفر

حياك الله اخوي حربي نعم ، هذا خطأ من جانبي ، فقد قرأت ملاحظتك في النموذج بطريقة غير صحيحة 1. احذف استعلام التحديث ، 2. استعمل هذا الكود على زر التحديث: Private Sub cmd_update_a_tlbia_Hr_Click() Dim rstS As DAO.Recordset Dim rstD As DAO.Recordset Set rstS = Me.TB.Form.RecordsetClone Set rstD = CurrentDb.OpenRecordset("Select * From a_tlbia_Hr") rstS.MoveLast: rstS.MoveFirst RCs = rstS.RecordCount Me.TB.SetFocus DoCmd.GoToRecord , , acFirst For i = 1 To RCs criti = "[ID_Sanf]='" & Me.TB!ID_Sanf & "'" criti = criti & " And" criti = criti & " [Rjmfatwra]='" & Me.TB!Rjmfatwra & "'" rstD.FindFirst criti 'rstD.FindFirst "[ID_Sanf]='" & Me.TB!ID_Sanf & "' And [Rjmfatwra]='" & me.TB!Rjmfatwra & "'" If rstD.NoMatch = False Then rstD.Edit rstD!Alkmiah_mtob = Me.TB!Alkmiah_mtob rstD!mjmo = Me.TB!mjmo rstD.Update End If DoCmd.GoToRecord , , acNext Next i DoCmd.GoToRecord , , acFirst rstS.Close: Set rstS = Nothing rstD.Close: Set rstD = Nothing End Sub جعفر

تفضل اخوي حربي نسخة من برنامج ابو زاهر بصيغة 2003 جعفر 947.ترحيل الطلبيه.mdb.zip

السلام عليكم ورحمة الله حل آخر في المرفق... أرجو ان يفي الغرض المطلوب... بن علية حاجي series.xls

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

اذا كنت تريد ان يظهر لك ما يحتوي التحديد الذي قمت به (بدون الخلايا الفارغة) استعمل هذا الملف الكود Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Selection.Cells(1, 1).Column = 1 Then Exit Sub If Selection.Cells.Count > 50 Then MsgBox "Too Many Data" Exit Sub End If Dim lasteRow Dim x% lasteRow = Cells(Rows.Count, 1).End(3).Row If lasteRow = 1 Then lasteRow = 2 If Application.CountA(Target) = 0 Then With Range("A1") .Value = Selection.Address With .Offset(1) .Resize(lasteRow, 1).Clear .Value = "Selection is Empty " .Interior.ColorIndex = 8 End With With .Offset(2) .Value = "ActiveCell is : " & ActiveCell.Address .Interior.ColorIndex = 3 .Font.ColorIndex = 2 End With End With Exit Sub End If Dim arr() Dim k%: k = 1 Dim cel As Range For Each cel In Selection If cel <> vbNullString Then ReDim Preserve arr(1 To k) arr(k) = cel.Value k = k + 1 Else: x = x + 1 End If Next With Me.Range("a1") .Value = Selection.Address .Offset(1).Resize(lasteRow, 1).Clear .Offset(1).Resize(k - 1, 1).Value = Application.Transpose(arr) With .Offset(k) .Value = "Active Cell is : " & ActiveCell.Address .Interior.ColorIndex = 3 .Font.ColorIndex = 2 With .Offset(1) .Value = "Items: " & Selection.Cells.Count - x .Interior.ColorIndex = 7 .Font.ColorIndex = 2 End With End With End With Me.Range("A:A").Columns.AutoFit Range("B1") = "Selection Address" Erase arr End Sub GET adderss of selection.xlsm

اولا احب ان اشكر كل اعضاء و مشرفى هذا المنتدى العظيم الذى تعلمت و لازلت اتعلم منه الكثير و الكثير و اليوم اقدم الى الجميع برنامج المخزون الشامل حيث قد طلب منى احد الاصدقاء برنامج لضبط حركه مخزون شركته وهى شركه مستحضرات تجميل فقد قمت بعمل هذا البرنامج الذى يصلح لكل انواع المخزون مع بعض التعديلات البسيطه نبذه صغيره عن البرنامج 1-برنامج يحتوى على صفحه فواتير المبيعات و المشتريات و المرتجعات 2-و يحتوى على صفحه كشف حسب العملاء التى توضح المدفوع و المستحق خلال فترات معينه 3- صفحه التقارير وتضم حركه الاصناف حركه الفواتير وتقرير شامل بالمبيعات و المشتريات خلال اى فتره انت تحددها 4- كما يمكنك ادخال اى سند سواء كان صرف او قبض من خلال فورم ادخال السندات 5- حركه المخزون و التى توضح الربح و الخساره لكل صنف على حده و المزيد و المزيد من المزايا الاخرى التى سوف تكتشفها بنفسك ملاحظات تم عمل البرنامج على اكسيل2010 وتم تجربته بنجاح على اكسيل 2010 الرقم السرى للدخول الى البرنامج هو 123 وانصح جميع الاخوه الذين يجربون البرنامج ان يتم تجريبه على نفس الاصدار تجنبا لحدوث اى مشاكل تم رفع البرنامج على موقع الميديا فير حيث ان حجم البرنامج 2 ميجا بايت كما ارحب براى الاخوه و الخبراء فى البرنامج سواء كان نصيحه او نقد او معلومه جديده كما انوه باننى جاهز لاى استفسار او تعديل لهذا البرنامج لمن يريد على حسب طبيعه عمله و على حسب وفت فراغى و اخيرا اشكر كل اعضاء ومشرفى هذا الصرح العظيم الذى تعلمت منه التحميل من الرابط التالى http://www.mediafire.com/file/u34hp2c38h6slc7/برنامج المخزون الشامل.rar برنامج المخزون الشامل.rar

بكبسة زر واحدة نستطيع ان نعرف ما هو اخر صف غير فارغ في كل شيت انظر المرفق (Sheet1) Last_row In sheets.xlsm

اذا كان معنا نص معين و نريد ان نعرف الكلمة رقم 2 او 5 أو ....... فيه كيف تفعل ذلك لا تيأس اكسل يحل لك هذه المشكلة N_th word.xlsm

وعليكم السلام ورحمة الله وبركاته جرب احدى الطريقتين ، حسب نوع حقل catcod في الجدول: اذا كان نوع الحقل رقم payI=dlookup("[PriceBuy]","[category]","[catcod]=" & me.catcod) او اذا كان نوع الحقل نص payI=dlookup("[PriceBuy]","[category]","[catcod]='" & me.catcod & "'") جعفر

السلام عليكم ورحمة الله و بركاته نوعية البيانات في catcode ضمن الفورم مغايرة لنوعية الفورم في الجدول

استاذي الفاضل جعفر واستاذي الفاضل ابو زاهر شاكرا تعاونكم معي ربي يحفظكم يارب يارب جزاكم الله خيرا

وعليكم السلام ورحمة الله وبركاته استخدم الوحدة النمطية التالية: Public Function HoursToMinutes(ConvHoursMinutes As Single) As Long Dim WazMinutes As Integer If InStr(1, Str(ConvHoursMinutes), ".") > 0 Then WazMinutes = Val(Mid(Str(ConvHoursMinutes), InStr(1, Str(ConvHoursMinutes), ".") + 1)) End If HoursToMinutes = Int(ConvHoursMinutes) * 60 + WazMinutes End Function وقم باستدعائها كالتالي في الحقل الذي تريد ظهور النتيجة فيه: =HoursToMinutes([YourField])

وعليكم السلام اخوي عمر جرب هذه الطريقة: افتح الاكسس (مو قاعدة بياناتك ، وإنما برنامج الاكسس) ، ثم اختار قاعدة بياناتك ، واختار Open Exclusive . جعفر

وعليكم السلام ورحمه الله وبركاته وانت بالف خير أن شاء الله ارفعه لك ما يغلا عليك بس حاليا عندي مشكلة بالمتصفح ما بقدر ادخل من الكمبيوتر اول ما يصلح ابشر او يحولها لك اي احد من الاخوان تحياتي اليك

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

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

وعليكم السلام اخوي ابو زاهر تفضل: هذا استعلام تحديث الحقلين في الجدول a_tlbia_Hr ، وبمعيار الفاتورة ورقم الصنف . وهذا كود حدث نقر زر التحديث: Private Sub cmd_update_a_tlbia_Hr_Click() DoCmd.SetWarnings False DoCmd.OpenQuery "qry_Update_Alkmiah_mjmo" DoCmd.SetWarnings True End Sub . جعفر 947.ترحيل الطلبيه.accdb.zip

و عليكم السلام و رحمة الله وبركاته الغاء تأمين الخلايا للخلايا التي ليس بها معادلات ثم استخدم حماية ورقة sheet protect

اكتبه في حدث بعد التحديث او ارفع ملف مصغر يجرب عليه مع شرح المطلوب

تفضل الملف به دالة باستخراج تاريخ الميلاد والنوع ومحافظة الميلاد نموذج(1).xls

تفضل المطلوب في الملف المرفق لا شكر على واجبنموذج.xls

جرب forms![سمي النموذج الفرعي].Refresh

جرب هذه المعادلة =IF(ROWS($A$1:A1)<=MAX($B$2:$B$38),1,COUNTIF($B$2:B2,B2))

وعليكم السلام تفضل هذا الرابط به طريقة سهلة ، ولكن قم بتغيير الامر من Dlookup الى DCount جعفر

تم التغيبر فى نموذج الواجهة زرار الاستعلام عن متدرب تم التغيير فى تموذج الاستعلام عن متدرب عند التحميل برنامج أدارة المتدربين.mdb

الكود اشتغل 10/10 شكرا لك استاذي / محمد احمد لطفي هل من الممكن ان تظهر نافذه في حالة الضغط علي No بأن تظهر رسالة تقول بأنه تم الالغاء و شكرا لكم جميعا استاذتي الكرام

السلام عليكم تم عمل المطلوب في الملف المرفق... وأرجو أن يفي الغرض المطلوب... بن علية حاجي النسبة.xlsx

هل ما تقصده هو يوزرفورم 2 ؟

تفضل استعلام حذف.accdb

في فكرة ممكن تعجبك نعدل على الكود بحيث يضع المصروف من الكميات و المبالغ ب السالب " - " حتى تكون النتائج النهائية افضل ما رأيك

قم بالارشادات حسب الصورة اضغط فقط على الزر Run Salim_Dunia.xlsm

تم التعديل Sub Inqwayry() ' ‎26/08/2018 بواسطة ‎Zmn ' استخراج بيانات برقم الفاتورة Dim Q1, Q2, FR, TR Range("A11:L111").ClearContents Q1 = Range("C6").Value 'رقم الفاتور TR = 11 For Q2 = 1 To Sheets.Count If Sheets(Q2).Name = ActiveSheet.Name Then GoTo 3 With Sheets(Q2) For FR = 3 To 3333 If .Cells(FR, 14) = Q1 Then Cells(TR, 1) = .Cells(FR, 3) & .Cells(FR, 4) Cells(TR, 2) = .Cells(FR, 5) Cells(TR, 3) = .Cells(FR, 6) Cells(TR, 4) = .Cells(FR, 7) Cells(TR, 5) = Application.Sum(.Cells(FR, 8), .Cells(FR, 20)) Cells(TR, 6) = Application.Sum(.Cells(FR, 9), .Cells(FR, 21)) Cells(TR, 7) = Application.Sum(.Cells(FR, 10), .Cells(FR, 22)) Cells(TR, 8) = Application.Sum(.Cells(FR, 11), .Cells(FR, 23)) Cells(TR, 9) = Application.Sum(.Cells(FR, 12), .Cells(FR, 24)) Cells(TR, 10) = Application.Sum(.Cells(FR, 13), .Cells(FR, 25)) Cells(TR, 11) = .Cells(FR, 27) Cells(TR, 12) = .Cells(FR, 26) Cells(TR, 13) = Sheets(Q2).Name TR = TR + 1 End If Next FR End With 3 Next Q2 End Sub Testعمرضاحي.xls

اليوور فورم ليس من اختصاصي و انا لا أرغب العمل به اذا اردت يمكن عمل ذلك بواسطة الماكرو

الورقة One Client من هذا الملف بسم _الله.xlsx

جرب هذا الكود Option Explicit Sub give_data() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim arr(), m%: m = 1 Dim k%, i% Dim st$ Dim x% Dim Source_sh As Worksheet: Set Source_sh = Sheets("Data") Dim targ_sh As Worksheet: Set targ_sh = Sheets("Data1") targ_sh.Range("e4").CurrentRegion.Offset(1).ClearContents k = Source_sh.Range("d4").CurrentRegion.Rows.Count + 3 For i = 5 To k If Application.CountIf(Source_sh.Range("F5:F" & i), Source_sh.Range("F" & i)) = 1 Then ReDim Preserve arr(1 To m): arr(m) = Source_sh.Range("F" & i) m = m + 1 End If Next targ_sh.Range("E4").Resize(m - 1) = Application.Transpose(arr) For m = LBound(arr) To UBound(arr) For i = 5 To k If Source_sh.Range("f" & i) = arr(m) Then st = st & Source_sh.Range("G" & i) & Chr(10) End If Next st = Mid(st, 1, Len(st) - 1) targ_sh.Range("f" & m + 3) = st targ_sh.Range("f" & m + 3).WrapText = True st = "" Next x = Application.Max(targ_sh.Range("B:B")) + 3 targ_sh.Range("d4:d" & x).Formula = _ "=INDEX(Data!$E$5:$E$500,MATCH(E4,Data!$F$5:$F$500,0))" targ_sh.Range("G4:G" & x).Formula = _ "=INDEX(Data!$H$5:$H$500,MATCH(E4,Data!$F$5:$F$500,0))" targ_sh.Range("H4:H" & x).Formula = _ "=INDEX(Data!$I$5:$I$500,MATCH(E4,Data!$F$5:$F$500,0))" targ_sh.Range("I4:I" & x).Formula = _ "=INDEX(Data!$J$5:$J$500,MATCH(E4,Data!$F$5:$F$500,0))" targ_sh.Range("d4:I" & x).Value = targ_sh.Range("d4:I" & x).Value Erase arr With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub بالنسبة للجدولين في الورقة الاولى تم عمل المعادلات للجدول الاول فقط (لضيق الوقت) يمكن عمل المعادلات للجدول الثاني بنفس الصيغة الملف مرفق Data _salim.xlsm

تم التعديل كما تريد و زيادة حبتين Last_addres In sheets.xlsm

العلامة $ تستعمل لتثبيت الخلية و تكتبها بالضغط على الحرف F4 من لوحة المفاتيح مثال مثلا قف عند الخلية B1 و اكتب =A1 ثم اضفط على F4 بعد ذلك اسحب الى الاسفل الى عدد من الخلايا ستجد ان المعادلة لم تتغير كل الخلايا مساوية للخلية A1 لاننا ثبتناها اعد نفس العمل دون ان تضغط على F4 ستجد أن A1=B1 و A2=B2 و A3=B3 و الى آخر خلية