عبدالله المجرب

السلام عليكم اخي الصديق بصراحة لم افهم فكود التترحيل يعمل تمام التمام

اخي ابو تميم شاهد هذا الرابط http://www.officena.net/ib/index.php?showtopic=36524&hl=&fromsearch=1

اخي انس جرب هذا اكود راح يعطيك هذه الالوان Private Sub CommandButton1_Click() For E = 1 To 255 Range("A" & E).Interior.ColorIndex = Int(Rnd * 56) + 1 Next E End Sub

فكرة في غاية الروعة بصرحة وتنفيذ رائع ولكن يتطلب كتابة جميع الاسماء عن نفسي راح احاول ان اضع مقترحات

السلام عليكم تم عمل كود جديد شاهد المرفق كود جديد .rar

فكرة جميلة وموفقة

ما شاء الله عمل مميز كعادتك كنت قد جربت ان احل السؤال الخاص بالاخ الذي طلب الحل باستخدام حلقات التكرار وتثبيت الصفوف بالتنوب في الجمع لكني وجدت الحل طويل ويحتاج الى تجارب كثيرة فتوقفت على امل المحاولة في الاجازة لكن مثل هذا الحل الابداعي لا اجد الا الدعاء لك بان يبارك الله لك في ما من به عليك من العلم ما شاء الله لا زلنا في بداية الطريق نتعلم من اساتذة الاكسل فكل يوم نرى عجائب ابداعاتهم

استاذي الفاضل بن عليه القلوب عند بعضها

السلام عليكم هذا اختصار لكود الاستاذ بن عليه Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, [B4:E20]) Is Nothing Then Target.NumberFormat = Application.Rept(0, Target.Column) End If End Sub

السلام عليكم Sub Abu_Ahmed() [D3:D100].ClearContents: K = 1 For i = 3 To 33 If Cells(i + 1, 3) - Cells(i, 3) > 1 Then r = Cells(i + 1, 3) - Cells(i, 3) For e = 1 To r - 1 Cells(i + K, 4) = Cells(i, 3) + K K = K + 1 Next K = 1 End If Next End Sub شاهد المرفق receipt vouchers.rar

السلام عليكم ضع هذا الكود في حدث ورقة العمل Private Sub Worksheet_Change(ByVal Target As Range) Range("B4:E20").NumberFormat = "@" If Not Intersect(Target, [B4:E20]) Is Nothing Then Select Case Target.Column Case 2: If Len(Target) < 2 Then Target = "0" & Target Case 3: If Len(Target) < 3 Then w = 3 - Len(Target) Do Until Len(Target) = 3 Target = "0" & Target Loop Case 4: If Len(Target) < 4 Then w = 4 - Len(Target) Do Until Len(Target) = 4 Target = "0" & Target Loop Case 5: If Len(Target) < 5 Then w = 5 - Len(Target) Do Until Len(Target) = 5 Target = "0" & Target Loop End Select End If End Sub

السلام عليكم اعتذر عن التأخر في الرد جرب لمرفق بعد التعديل تامينات (1).rar

بارك الله فيك استاذ يحياوي

ضع هذا الكود في حدث ورقة (الشيت) Private Sub Worksheet_Activate() Abu_Ahmed End Sub

ان شاء الله ساشرح لك الكود كله صوتا وصورة ان توفر الوقت

السلام عليكم جرب المرفق نقل بيانات.rar

جرب المرفق بعد التعديل استبدال المعادلة Vlookup والارتباط التشعبي بكود يعمل نفس العمل.rar

السلام عليكم جرب المرفق البيانات مع الصورة.rar

ما شاء الله استاذ نارت اثريت منتدى الاكسل بقيم ما لديك

بارك الله فيك استاذ احمد على هذا العمل المميز

الى الغد ان شاء الله

السلام عليكم هل تقصد هكذا طريقة التعديل.rar

السلام عليكم ذكرتني بالذي مضى الملف لي وكنت قد سألت عن جواب لادراج الصورة من ملف خارجي والجواب لبن عليه واليك الرابط http://www.officena.net/ib/index.php?showtopic=35652 ========== واذا اردت موضوع اكثر احترافية للتعامل مع الصور من ملف خارجي فاليك هذا الرابط http://www.officena.net/ib/index.php?showtopic=40613

السلام عليكم اليك هذا الرابط http://www.officena.net/ib/index.php?showtopic=38766&st=0&p=211998&#entry211998

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