البحث في الموقع

السلام عليكم هذا كود من أعمال الأستاذ الكبير عبدالله باقشير حفظه الله ورعاه أحببت أن اطرحه في موضوع كي يستفيد منه الجميع في أول الكود تحط الشروط المراده * بداية البيانات بدون رؤس الاعمدة * الاعمدة المراد عمل عليها جمع بالامكان تحديد الاعمده اما بشكل فردي وهو "$A$1,$C$1,$F$1" أو بشكل مدى من الى هكذا "$A$1:$G$1" أو بشكل مدى متقطع هكذا "$A$1,$C$1,$E$1:$H$1,$i$1:$K$1" ******************************************************************** الكود ينشاء صف وبه الجمع وبعد الانتهاء من وضع معاينة الطباعه يحذف الصف ******************************************************************** الكود يوضع في مودويل '**************************************** ' بداية البيانات بدون رؤس الأعمدة Private Const Row_Star As Integer = 2 '**************************************** 'الاعمدة المراد جمع قيمها في نهاية فواصل الصفحات Private Const C_N As String = "$A$1,$C$1,$D$1:$F$1" Sub Ali_Sum_Page() Dim Ar() As Integer Dim Rng As Range, Cc As Range Dim C As Range, Cr As Range Dim iCont As Integer Dim i As Integer, ii As Integer Dim r1 As Integer, r2 As Integer Dim Cv As Integer, L_C As Integer ''''''''''''''''''' For Each Cc In Range(C_N) L_C = Cc.Column Next With Cells.Worksheet With .PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With .ResetAllPageBreaks .Range("A65536").Select .Cells(Row_Star, "A").Select iCont = .HPageBreaks.Count If iCont = 0 Then Exit Sub ''''''''''''''''''''''' ReDim Ar(1 To iCont) For i = 1 To .HPageBreaks.Count ii = .HPageBreaks(i).Location.row Ar(i) = ii Next ''''''''''''''''''''''' r1 = Row_Star For i = 1 To iCont ii = Ar(i) - 1 With .Range("A" & ii).Resize(1, L_C) .EntireRow.Insert With .Offset(-1, 0) L_r = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row If Rng Is Nothing Then Set Rng = .Cells Else Set Rng = Union(Rng, .Cells) r2 = ii - 1 For Each C In Range(C_N) Cv = C.Column .Cells(1, Cv) = WorksheetFunction.Sum(Range(Cells(r1, Cv), Cells(r2, Cv))) Next r1 = r2 + 2 End With End With Next For Each Cr In Range(C_N) Cv = Cr.Column With .Cells(L_r, Cv) .Value = WorksheetFunction.Sum(Range(Cells(r1, Cv), Cells(L_r - 1, Cv))) .Interior.ColorIndex = 6 End With Next End With '''''''''''''''''''''' If Not Rng Is Nothing Then With Rng .Interior.ColorIndex = 6 .Worksheet.PrintPreview Range("A" & L_r).EntireRow.Delete .EntireRow.Delete End With End If ''''''''''''''''''''''' Erase Ar Set Rng = Nothing: Set Cc = Nothing Set Cr = Nothing: Set C = Nothing End Sub والسلام عليكم

السادة الكرام سلام الله عليكم ورحمته وبركاته ----- المطلوب عندما يتم كتابة تاريخين من والي في الخليتين B3 , B4 والضغط علي الزر يتم كتابة رقم 1 في النطاق من H:H في Sheet2 امام اي صف ينحصر بين هذين التاريخين " اي يكون اكبر من او يساوي التاريخ الاصغر واقل من او يساوي التاريخ الاكبر " كما هو موضح بالمرفق ------ وشكرا جزيلا استفسار هاااام.zip

السلام عليكم ورحمة الله وبركاتة . هذا الملف المرفق هو تلوين صف نشط . أولا يوجد أهتزاز في الورقة عند المشى بالأسهم ياريت أن تجعلوه لي لا تهتز الورقة أثناء التحريك وثانيا أريد حماية الخلايا التي أنا أريدها علما أستخدمت الكود التالي ولا فائدة وشكرا جدا ActiveSheet.Unprotect ActiveSheet.Protect 23321.rar

السلام عليكم . هذا ملف مرفق أريد به لو تكرمتم حماية الشيت ولكن الكود لا يعمل عند حماية الشيت ويظهر لي رساله أريد حماية بدون أي خطأ 2014.rar

كود إدراج صفوف أعلى عدد من الصفوف بمعلومية الصف الأول وعدد الطلاب وهذا مفيد لإعداد شيت الدور الثانى التحميل من هنا بالتوفيق إنشاء الله

السلام عليكم Option Explicit ' بسم الله الرحمن الرحيم " ' ********************* " ' دالة استخراج النص او الارقام " '==============================================" ' False = مهمل او Kh_Number اذا كان " ' تقوم باستخراج النص " ' True = Kh_Number اذا كان " ' تقوم باستخراج الارقام " '==============================================" '----------------------------------------------------------------- Function Kh_Replace_Text(ByVal Kh_Sub As String, Optional Kh_Number As Boolean) Dim Num As Byte, C As Integer Dim Sn As String, Re As String, Md As String Sn = Trim(Kh_Sub) For Num = 0 To 9 Sn = Replace(Sn, Num, "") Next Num If Kh_Number Then Re = Trim(Kh_Sub) Do While C < Len(Trim(Sn)) C = C + 1 Md = Mid(Sn, C, 1) Re = Replace(Re, Md, "") Loop Kh_Replace_Text = CDbl(Re) Else Kh_Replace_Text = Trim(Sn) End If End Function دالة استخراج النص او الارقام.rar

إخوتي وأحبتي حين يكون لدينا نموذج أصل (أب) لعرض السجلات في جدول ما ، ويكون في هذا النموذج مربع تحرير وسرد يكون مصدر الصف فيه جدول العملاء ، ونحتاج لنموذج تابع منبتق لتسجيل عميل جديد ، وفي نفس الوقت وبعد إضافة معلومات العميل نريد أن يتم تحديث مصدر الصف في مربع التحرير و السرد في النموذج الأصل ليتم إظهار السجل الجديد ، مع العلم بأن النموذج المنبثق الخاص بإدخال سجلات العملاء الجدد سيتم في التطبيق إستدعاؤه من أكثر من مكان أو نموذج ، أي أنه لا يستوي الأمر معنا بتحديث مصدر الصف لمربع التحرير و السرد في النموذج الأصل من خلال زر الأمر عند إغلاق النموذج المنبثق وإلا سنضطر لإنشاء أكثر من نموذج منبثق لإستدعاء كل واحد منهم مرتبطا بكود تحديث معلومات كل نموذج استدعاه. Forms!Form1!combo2.Requery ويكمن الحل في تحديد شرط تحديث مصدر الصف لمربع التحرير و السرد في النموذج الأصل مع أمر إستدعاء النموذج المنبثق ، ومن النموذج الأصل ، وبذلك أيضا يمكن إستخدام وإستدعاء نفس النموذج المنبثق من أكثر من نموذج لعدم إرتباطه بأيها، وذلك بإستخدام الكود التالي خلف زر أمر إستدعاء النموذج المنبثق من النموذج الأصل : DoCmd.OpenForm "frmAddCustomer", WindowMode:=acDialog Me.TaxNum.Requery وقضي الأمر مرفق تطبيق للتوضيح ............. NA_RequeryingComboBox.rar