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

جزاكم الله خيرا

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

السلام عليكم في اي شيت تريد العمل

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

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

السلام عليكم الشكر واصل لجميع المشاركين ...جزاكم الله خير لاثراء الموضوع يمكنك استخدام هذا الكود لجميع الازرة فهو يستخدم الاسم الذي على الزر للاستعلام عن اسم الورقة Sub Kh_Sheets_Go() On Error Resume Next Dim Kh_Name As String Kh_Name = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text With Sheets(Kh_Name) .Visible = xlSheetVisible .Select End With On Error GoTo 0 End Sub المرفق 2010 نموذج.rar

و

السلام عليكم هذا يعمل مع جميع الازرة المرفق 2003 أوائل الطلبه وشهادات 4.rar

وعليكم السلام عندك في الكود اربعة اعمدة .Cells(LR, 1) = Target.Value .Cells(LR, 2) = Format(Now, "h:mm:ss") .Cells(LR, 3) = Format(Date, "dd-mm-yyyy") .Cells(LR, 4) = Target.AddressLocal يمكنك اضافة اي عمود واسند له القيمة التي تريدها مثلا Cells(LR, 5)="s"

السلام عليكم تفضل غير الرقم 90 الى العمود الذي تريد Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Long Select Case Target.Column: Case 1 To 90 If Not IsEmpty(Target) Then With Sheets("تعديلات") LR = .Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(LR, 1) = Target.Value .Cells(LR, 2) = Format(Now, "h:mm:ss") .Cells(LR, 3) = Format(Date, "dd-mm-yyyy") .Cells(LR, 4) = Target.AddressLocal End With End If End Select End Sub تحياتي

السلام عليكم التعديل على كود قديم يكون صعب ويشتي تركيز المهم جرب زر دور ثاني المرفق 2003 أوائل الطلبه وشهادات3.rar

جزاهم الله عنا خير الجزاء

السلام عليكم المرفق 2010 بحث بكاتة داخل خلية22.rar

السلام عليكم ممكن هذا التعديل الطفيف وهو تعديل فورنكست لتبدأ من الاعلى الى الاسفل Sub duplicate_AWB() lr = [m400].End(xlUp).Row For r = 4 To lr x = Cells(r, 13).Value If WorksheetFunction.CountIf(Range("m4:m" & lr), x) > 1 Then Cells(r, 3).Resize(1, 25).ClearContents End If Next r End Sub تحياتي

التهنئة بترقية الاخت أم عبدالله الى خبير معتمد وهذه السابقة الاولى ان تحصل احد العضوات على هذه الرتبة حسب ما صرح به مدير المنتدى ملحوظة :سيتم نقل الموضوع الى المنتدى الاجتماعي بعد حين

السلام عليكم الشكر واصل للاخ جمال شاهد المرفق2003 بحث بكاتة داخل خلية.rar

السلام عليكم هذه معادلة التنسيق الشرطي =OR(WEEKDAY(A1)=3;WEEKDAY(A1)=7) تحياتي تنسيق شرطى للتاريخ.rar

السلام عليكم قد لا استطيع ان افيدك في ما تريد اعمل موضوع جديد بطلبك هذا لكي ينتبه لطلبك الموجودين تحياتي

اضفت السطر هذا الى الدالة .Line.Visible = msoFalse ضعه في المكان الذي تراه موجود فيه ادناه في كود الدالة في ملفك Option Explicit Option Compare Text '============================================= ' عرض صورة في الخليةِ ' Showing an image in cell '============================================= ' اسم مجلد الصور ' اذا كان مجلد الصور في نفس مجلد ملف الاكسل ' اكتب اسمه فقط ' والا اكتب المسار كاملا ' "D:\MyDocument\MyFunction\photo" Private Const kh_pic As String = "MyImeg" '============================================= ' امكانية تحرير اي نوع من الصور لديك ادناه Private Const MyTyp As String = ".jpg,.bmp,.gif,.png,.tif" '============================================= '============================================= Function kh_ShowImage(ByVal NameImag, ByVal ImagRng As Range, Optional ByVal MyWidth As Single, Optional ByVal MyHeight As Single) Dim Tp Dim shp As Shape Dim ibo As Boolean Dim MyTop As Single, MyLeft As Single Dim MyFile As String, MyPath As String '---------------------------------- On Error GoTo 1 '---------------------------------- MyTop = ImagRng.Top: MyLeft = ImagRng.Left With ImagRng.Worksheet For Each shp In .Shapes If shp.Top = MyTop And shp.Left = MyLeft Then shp.Delete: Exit For End If Next shp End With '----------------------------------- If IsEmpty(NameImag) Then GoTo 1 '----------------------------------- If MyWidth = 0 Then MyWidth = ImagRng.Width If MyHeight = 0 Then MyHeight = ImagRng.Height '----------------------------------- If Not InStr(kh_pic, ":") Then MyPath = ThisWorkbook.path & "\" MyFile = MyPath & kh_pic & "\" & CStr(NameImag) '----------------------------------- For Each Tp In Split(MyTyp, ",") If Not Dir(MyFile & Trim(Tp), vbDirectory) = vbNullString Then With ImagRng.Worksheet.Shapes.AddShape(msoShapeRectangle, MyLeft, MyTop, MyWidth, MyHeight) .Fill.UserPicture MyFile & Trim(Tp) .Line.Visible = msoFalse End With ibo = True Exit For End If Next 1 kh_ShowImage = ibo End Function اما الدمج فلا انصح به تحياتي

السلام عليكم جربي هذه المعادلة =IFERROR(VLOOKUP(C3;DATA!$B$3:$G$15;6;0);"") المرفق 2010 مثال+++.rar

======================== الاخ الحبيب/ ضاحي الغريب ======================== و

السلام عليكم يعمل الكود عندما يتم التغيير في الخلية F1 المرفق 2003 أوائل الطلبه وشهادات3.rar

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

جزاكم الله خيرا

السلام عليكم استخدم ctrl+f1 للاخفاء والاظهار