عبدالله باقشير

السلام عليكم شكرا لك اخي الحبيب طارق على التثبيت وعلى التشجيع شكرا لك اخي الحبيب هاني على كرمك المتواصل شكرا لك اخي الحبيب سامي على الدعاء جزاكم الله خيرا -------------------------------------------- نواصل سلسلة هل تعلم تعديل عرض اعمدة اللست بهذا السطر لو فرضنا ان عدد الاعمدة ثلاثة Me.ListBox1.ColumnWidths = "23,100,100" في المرفق تطبيق لنموذج عرض وتعديل اوردت فيه هذه المعلومة و ما علمناه سابقا المرفق 2003/2007 نموذج عرض وتعديل بيانات.rar

السلام عليكم ورحمة الله وبركاته اخواني الاحباء من رفع يده بالدعاء ومن شكر وثناء حفظكم الله ورعاكم ====================== جزاكم الله خيرا وبارك الله فيكم تقبلوا تحياتي وشكري =======================

السلام عليكم ورحمة الله وبركاته اخواني الاحباء محمدي حسن حفظكم الله ورعاكم ====================== جزاكم الله خيرا وبارك الله فيكم تقبلوا تحياتي وشكري =======================

السلام عليكم هذا السطر SH_ALI.Range(Cells(R, 1), Cells(R, 39)).Cop SH_ALI.Range(Cells(3, 1), Cells(R, 39)).Copy جرب لنسخ السطر الاخير استبدل بهذا

السلام عليكم احبتي في الله انا نفسي نفذت مني الكلمات لم تبقى معي الا قطرات دمعي جزاكم الله خيرا هذا مرفق امثلة لما ذكر امثلة.rar

جزاك الله خيرا تقبل تحياتي وشكري

هل تعلم هل تعلم انه بامكانك اضافة لست الى ListBox من نص بهذا الكود Me.ListBox1.List = Split("عبدالله علي باقشير") او من نص في اي خلية Me.ListBox1.List = Split(CStr(Range("A1")))

السلام عليكم هل تعلم انه بامكانك اضافة لست الى ListBox بهذا السطر Me.ListBox1.List = Range("i1").Resize(10, 2).Value واخراج بيانات اللست الى خلايا Range("c1").Resize(10, 2) = Me.ListBox1.List

اخي محمد صالح حفظك ربي نفس الحكاية دي عندي هل هناك حل نريد ان نرى هذه الماسه تقبل تحياتي وشكري

تواضع وحب العلم واحترام بارك الله فيكم جميعا

السلام عليكم تم التعديل على كود ابو انصار حفظه الله Sub COPY_ALIDROOS() Dim W_ALI As Workbook, WB_ALI As Workbook Dim N_ALI$, CH_ALI$ Dim SH_ALI As Worksheet Dim T%, R%, co% Application.ScreenUpdating = False '============================================ ' هنا تحط مسار مجلد الملفات التي تريد جلب بياناتها CH_ALI = "C:\Mine\" 'CH_ALI = ThisWorkbook.Path & "\Mine\" '============================================ N_ALI = Dir(CH_ALI & "\*.xlsx") Set W_ALI = ThisWorkbook Do While N_ALI <> "" Set WB_ALI = Workbooks.Open(CH_ALI & "\" & N_ALI) Set SH_ALI = WB_ALI.Worksheets(1) R = SH_ALI.Cells(Rows.Count, 1).End(xlUp).Row If R = 2 Then GoTo 1 '============================================ '(A-E-F)هنا الاعمدة المراد جلب بياناتها هيا حسب طلبك هيا ' إبتداء من السطر الثالث Union(SH_ALI.Range("A3:A" & R), SH_ALI.Range("E3:E" & R), SH_ALI.Range("F3:F" & R)).Copy '============================================ W_ALI.Activate With W_ALI.Worksheets(1) T = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 .Range("A" & T).PasteSpecial xlPasteValues kh_Delete Selection End With 1: WB_ALI.Close 0 N_ALI = Dir Loop Application.ScreenUpdating = True Set W_ALI = Nothing: Set WB_ALI = Nothing: Set SH_ALI = Nothing End Sub Sub kh_Delete(Rng As Range) Dim Col As Range, Rw% With Rng For Rw = 1 To .Rows.Count If Val(.Cells(Rw, 2)) + Val(.Cells(Rw, 3)) = 0 Then If Col Is Nothing Then Set Col = .Rows(Rw) Else _ Set Col = Union(Col, .Rows(Rw)) End If Next End With If Not Col Is Nothing Then Col.Delete Shift:=xlUp End If End Sub شاهد المرفق2007 MAIN.rar

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

السلام عليكم لا يوجد عندي 2010 حسب ما فهمت المشكلة عند فتح الفورم يعني قد تكون في UserForm_Activate اذا حول الكود اللي فيه الى UserForm_Initialize واخبرني النتيجة تقبل تحياتي وشكري

السلام عليكم ورحمة الله وبركاته اخواني الاحباء ابو انس حاجب كات njbasm يحياوي الجزيرة almhb جلال محمد قصي عبد الله الشهابي حفظكم الله ورعاكم ====================== جزاكم الله خيرا وبارك الله فيكم تقبلوا تحياتي وشكري =======================

السلام عليكم ورحمة الله وبركاته اخواني الاحباء علي قصي محمد حفظكم الله ورعاكم ====================== جزاكم الله خيرا وبارك الله فيكم تقبلوا تحياتي وشكري =======================

السلام عليكم ورحمة الله وبركاته فورم لتقويم ميلادي تضع من خلاله التاريخ على الخلية النشطة بامكانية التنقل بين الخلايا والعمل بالفورم اكسل 2003 اكسل2007 فورم تقويم ميلادي لادراج التاريخ.rar

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

السلام عليكم ورحمة الله وبركاته اخواني الاحباء ابو انس habibdar نزاهة الشهابي نادر jazea يحياوي الحسامي احمد زمان طاهر احمد حمور حفظكم الله ورعاكم ====================== اعذروني لم استطع التعبير عرفانا لما اورتموه من الكلام الطيب اكرمكم الله وجزاكم خيرا في الدنيا والآخرة ====================== ودمتم في حفظ الله

السلام عليكم ورحمة الله وبركاته جمعة مباركة على الجميع اخي الحبيب / عبدالله -حفظك الله و جزاك الله خيرا ----------------------------------------------- اخي الحبيب / طارق -حفظك الله و جزاك الله خيرا الجواب: كما قاله ابو انصار جعلنا الليبل LabelEvent هو اساس التحكم و عن طريقه يتم التعامل مع 24 ليبل و لو جعلت خلفيته غير شفافة ستلاحظ انه في الامام ولن ترى 24 ليبل لانها خلفه عن طريق الضغط على الماوس على الليبل LabelEvent يتم تحديد عنوان الليبل اللي خلفه بالدالة MyIndex ويتم التعامل معه بالكود kh_Test وقد عملت فورم للتاريخ الميلادي بنفس هذه الالية --------------------------------------------- اخي الحبيب / مجدي يونس -حفظك الله و جزاك الله خيرا اخي الحبيب / aboalaa-حفظك الله و جزاك الله خيرا اخي الحبيب / انيس -حفظك الله و جزاك الله خيرا اخي الحبيب / ابو انصار-حفظك الله و جزاك الله خيرا لقد اصبت الهدف عندك حب شغوف للتعلم مع ذكاء ملحوظ اخي الحبيب / ابو الحسن -حفظك الله و جزاك الله خيرا تقبلوا جميعا شكري وتقديري ودمتم في حفظ الله اضفت حركة بسيطة لتبسيط اللعبة تفضلوا المرفق ملف 2003/2007 لعبة التركيز1.rar

السلام عليكم ورحمة الله وبركاته هي لعبة معروفه لديكم ولكن هذا العمل لم ينجز من اجل عيون اللعبة وانما لنتعلم وهو نفس عمل آلية الحروف المعمولة في ملف شرح دوال الاكسل ستجدون الكثير من الاسئلة التي تحتاج الى اجابة في هذا العمل ضعوها هنا لنرد عليها ساعطيكم انا اول سؤال فان لم اجد اجاية ساجيب لاحقا لدينا 24 ليبل لاظهار ما تروه امامكم من صور ولا يوجد اي امر يستخدم من احداث هذه الليبلات لا عبر الفورم ولا عبر موديل كلاسس ولكن عند الضغط على الليبل يتحقق حدث معين كيف ذلك ؟ ودمتم في حفظ الله ================================== تعديل بسيط افي المرفق ملف اكسل 2003و2007 لعبة التركيز1.rar لعبة التركيز.xls

السلام عليكم اخي الحبيب اود ان اجيب عليك ولكن على ما اظن انه على حسب الامان المستخدم عند التحويل والله اعلم هذه المعلومة ستجدها عند اخي يحياوي تقبل تحياتي وشكري

السلام عليكم الشكر واصل لجميع المشاركين بارك الله فيهم هذا ما اردناه من المشروع فورم لشرح دوال الاكسل متبقي الخطوة النهائية تفضلوا المرفق فورم لدوال الاكسل.rar

السلام عليكم استخدم مثلا الكود التالي: Private Sub Worksheet_Change(ByVal Target As Range) Dim RN As Range On Error GoTo 1 Select Case Target.Address Case [D8].Address Set RN = Evaluate("موادـورقة1") C = WorksheetFunction.Match(CStr(Target), RN, 0) Target.Offset(1, 0).Resize(4, 1).Value = RN.Columns(C).Offset(1, 0).Resize(5, 1).Value Case [J8].Address Set RN = Evaluate("موادـورقة2") C = WorksheetFunction.Match(CStr(Target), RN, 0) Target.Offset(1, 0).Resize(4, 1).Value = RN.Columns(C).Offset(1, 0).Resize(5, 1).Value End Select Set RN = Nothing 1: End Sub هل يمكن عمل حدث change مرتين.rar

السلام عليكم جرب الكود التالي: Option Explicit Sub Kh_Find_Delete() Dim MyTextFind, kh_msg Dim MySh As Worksheet Dim C As Range, CC As Range Dim FirstAddress As String Dim Tb As Boolean MyTextFind = Application.InputBox("اكتب ما تريد البحث عنه ؟", "بحث في جميع الاوراق الظاهرة") If MyTextFind = "" Or MyTextFind = False Then Exit Sub For Each MySh In ActiveWorkbook.Worksheets If MySh.Visible = xlSheetVisible Then 1: With MySh.Cells Set C = .Find(MyTextFind, LookIn:=xlValues) If CC Is Nothing Then Tb = True Else If Intersect(CC, C) Is Nothing Then Tb = True Else Tb = False If Not C Is Nothing And Tb Then FirstAddress = C.Address Do MySh.Activate C.Select '------------------------- kh_msg = MsgBox("تم ايجاد قيمة البحث في العنوان " & C.Address & Chr(10) & Chr(10) & "قيمة البحث هي: " & C.Value _ & Chr(10) & Chr(10) & "هل تريد حذف الصف ؟", 524288 + 1048576 + 256 + 3, "النتائج في: " & MySh.Name) Select Case kh_msg Case 2: GoTo kh_Exit Case 6: C.EntireRow.Delete: GoTo 1 Case 7: If CC Is Nothing Then Set CC = C Else Set CC = Union(CC, C) End Select '------------------------- Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With End If Set CC = Nothing Next MySh MsgBox IIf(Len(FirstAddress), "انتهى البحث", "لا توجد نتائج للبحث "), 524288 + 1048576, "بحث" kh_Exit: Set C = Nothing End Sub واخبرني بالنتيجة

Option Explicit Sub Kh_Find_All() Dim MyTextFind As Variant Dim MySh As Worksheet Dim C As Range, CC As Range Dim FirstAddress As String MyTextFind = Application.InputBox("اكتب ما تريد البحث عنه ؟", "بحث في جميع الاوراق الظاهرة") If MyTextFind = "" Or MyTextFind = False Then Exit Sub For Each MySh In ActiveWorkbook.Worksheets If MySh.Visible = xlSheetVisible Then With MySh.Cells Set C = .Find(MyTextFind, LookIn:=xlValues) If Not C Is Nothing Then FirstAddress = C.Address Do MySh.Activate C.Select '------------------------- If MsgBox("تم ايجاد قيمة البحث في العنوان" & Chr(10) & Chr(10) & MySh.Name & "!" & C.Address _ & Chr(10) & Chr(10) & "هل تريد حذف الصف ؟", 524288 + 1048576 + 4, "تاكيد") = 6 Then If CC Is Nothing Then Set CC = C Else Set CC = Union(CC, C) End If '------------------------- If MsgBox("هل تريد الاستمرار في البحث ؟", 524288 + 1048576 + 4, "تاكيد") = 7 Then GoTo 1 Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With End If '----------------------------------------- If Not CC Is Nothing Then CC.EntireRow.Delete: Set CC = Nothing '----------------------------------------- Next MySh MsgBox IIf(Len(FirstAddress), "انتهى البحث", "لا توجد نتائج للبحث "), 524288 + 1048576, "بحث" 1: If Not CC Is Nothing Then CC.EntireRow.Delete: Set CC = Nothing Set C = Nothing End Sub