أبو حنــــين
-
Posts
2,845 -
تاريخ الانضمام
-
Days Won
9
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
كل منشورات العضو أبو حنــــين
-
السلام عليكم جرب المرفق Form-1.rar
-
السلام عليكم جري هذا الكود Sub iCopy_ActiveSheet() Dim iPath As String, N As String iPath = ThisWorkbook.Path & "\" N = InputBox("أكتب هنا إسم الملف", "تحديد الإسم") If N = "" Then Exit Sub Application.DisplayAlerts = False ActiveSheet.Copy With ActiveWorkbook .SaveAs Filename:=iPath & N .Close End With Application.CutCopyMode = False: Application.DisplayAlerts = True End Sub -
إنني وقعت في نفس الذي وقعت فيه أنت سابقا حينما اجبت عن السؤال و قلت لك يومها ان الاخ الزباري يريدها عن طريق Loop كما تدين تدان الحل الجميل و الذي اعجبني هو عن طريق Array
-
و لإثراء الحلول هذه طريقة أخرى تؤدي نفس العمل Sub Test5() Application.ScreenUpdating = False For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row If Not Cells(i, 1) = "" Then x = Range("A" & i).Row: GoTo 200: End If If Cells(i, 1) = "" Then xx = Range("A" & i).Row: GoTo 100: End If 100 With Range(Cells(x, 1), Cells(xx, 1)) .Merge: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter End With 200 Next Application.ScreenUpdating = True End Sub
-
في هذه الحالة علينا ان نحذف السطر : Range("a1").Select و نضع مكانه السطر : ActiveSheet.UsedRange.Select
-
جميل و يمكن ان نستعمل كود آخر Sub Text3() i = 1 Do While i <= Cells(Rows.Count, "A").End(xlUp).Row If Trim(LCase(Cells(i, 2))) = Trim(LCase("student")) Then _ Range(Cells(i, 1), Cells(i, Cells(1, Columns.Count).End(xlToLeft).Column)).Interior.ColorIndex = 4 i = i + 1 Loop End Sub
-
جميل لكن الأخ الزباري يريد استعمال الدالة loop و إلا فالطرق كثيرة للحصول على النتيجة
-
جميل ما الذي يحدث لو كانت إحدي الخلايا فارغة في العمود A جرب مسح الخلية A4 مثلا
-
السلام عليكم بالفعل أخي الزباري و في هذه الحالة سنحسب آخر عمود بناءا على عناوين الصف الأول و نسميه مثلا : LastCol LastCol = Cells(1, Columns.Count).End(xlToLeft).Column ثم نغير الرقم 3 في الكود بالمتغير LastCol
-
السلام عليكم بالنسبة لسؤال أخي سلم Sub tlween1() Range("a1").CurrentRegion.Interior.ColorIndex = xlNone Cells(1, 1).Activate Do While ActiveCell <> "" If Trim(LCase(ActiveCell.Offset(0, 1).Value)) = Trim(LCase("student")) Then _ ActiveCell.Resize(1, 3).Interior.ColorIndex = 4 End If ActiveCell.Offset(1, 0).Activate Loop End Sub و هناك كود آخر يعمل نفس العمل Sub Text2() Dim c As Range For Each c In ActiveSheet.UsedRange If Trim(LCase(c.Value)) = Trim(LCase("student")) Then Range(Cells(c.Row, 1), Cells(c.Row, 3)).Interior.ColorIndex = 4 Next End Sub
-
حل ممتاز أخي الجموعي و لتفادي الخطأ نضيف IFERROR =IFERROR(MID(A2;FIND(":";A2)+1;FIND("-";A2;FIND(":";A2)+1)-FIND(":";A2)-1);"")
-
السلام عليكم اذا كانت الاسماء مكتوبة بالشكل الموجود في الملف فهذه دالة مستحدثة تقوم بالمطلوب mother-name.rar
-
السلام عليكم جزاك الله خيرا أخي الزباري على هذا الشرح لفتت إنتباهي كلمة في كود أخي إبراهيم أبو ليله في سطره الأول : و هي كلمة odd فأردت المشاركة بإستعمال هذه الكلمة : Sub test() Dim i As Integer, x As Integer x = 1 For i = 1 To 16 Step 2 Cells(x, 1) = WorksheetFunction.Even(i) Cells(x, 2) = WorksheetFunction.Odd(i) x = x + 1 Next i End Sub
-
السادة الافاضل ارجوا مساعدتى فى هذا الكود
أبو حنــــين replied to كريم 201190's topic in منتدى الاكسيل Excel
السلام عليكم ضع هذا السطر مكان السطر الذي يحتوي على الخطأ Me.TextBox1 = Format(cl.Offset(0, 3), "yyyy/mm/dd") -
ترحيل من شيت لأخر مع شرط وطباعة تقرير
أبو حنــــين replied to رؤوف1951's topic in منتدى الاكسيل Excel
السلام عليكم هناك مربع نص إسمه TxtDat أجرينا الكود في الحدث : TxtDat_Exit أي عند كتابة التاريخ و الخروج من مربع النص ( Exit ) أدرجنا السطر If Not IsDate أي إذا كان النص المدخل ليس بتاريخ ( رقم مثلا او نص ) يقوم الكود بتفريغ مربع النص " " = TxtDat -
بهذا الكود Sub CopyAll() Dim sh As Worksheet, LR As Long, Last As Long Application.ScreenUpdating = False For Each sh In Sheets If Not sh.Name = ActiveSheet.Name Then Last = sh.Cells(Rows.Count, 1).End(xlUp).Row LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 sh.Range("A2:M" & Last).Copy ActiveSheet.Range("A" & LR).PasteSpecial xlPasteValues End If Next Application.ScreenUpdating = True End Sub
- 1 reply
-
- 1
-
-
مرحبا اخي ابو بكر جرب ان تقوم بتعطيل وحدات الماكرو و افتح الملف إن فتح الملف فهناك كود يقوم بغلق الاكسل لسبب ما موجود ضمن الكود و ان لم يفتح فربما انه اصبح غير صالح
-
ترحيل من شيت لأخر مع شرط وطباعة تقرير
أبو حنــــين replied to رؤوف1951's topic in منتدى الاكسيل Excel
العفو أخي رؤوف -
ترحيل من شيت لأخر مع شرط وطباعة تقرير
أبو حنــــين replied to رؤوف1951's topic in منتدى الاكسيل Excel
السلام عليكم تم عمل المطلوب : BookExample_V2.rar -
ترحيل من شيت لأخر مع شرط وطباعة تقرير
أبو حنــــين replied to رؤوف1951's topic in منتدى الاكسيل Excel
السلام عليكم أخي رؤوف ما هي الأعمدة المعنية بالجمع -
ترحيل من شيت لأخر مع شرط وطباعة تقرير
أبو حنــــين replied to رؤوف1951's topic in منتدى الاكسيل Excel
السلام عليكم أخي رؤوف جرب المرفق BookExample_V1.rar -
السلام عليكم بالنسبة للسؤال الاخير حول الجدول يصبح الكود بهذا الشكل Sub Button2_Click() Last = Cells(Rows.Count, "F").End(xlUp).Row Range("F" & Last & ":W" & Last).AutoFill Destination:=Range("F" & Last & ":W" & Last + 1), Type:=xlFillDefault Range("F" & Last + 1) = Last - 9 Range("F" & Last + 2).Select End Sub بالنسبة للسؤال المتعلق بالجمع فهو غير واضح اين هو موقع الخلايا التي تحتوي على الجمع وما هي الاعمدة الاتي تقوم بجمع قيمها انت لم توضح ذلك في الملف المرفق
-
السلام عليكم قمت بوضع كود لكن الكتابة ظهرت غير سليمة جرب الكود عندك بوضع الملفات النصية في نفس مسار ملف الإكسيل Sub Get_My_File() Dim i As Integer, M Set M = CreateObject("Scripting.FileSystemObject") Set iPath = M.GetFolder(ThisWorkbook.Path & "\") i = 1 Application.ScreenUpdating = False For Each iFile In iPath.Files If Right(iFile.Name, 3) = "txt" Then Open iFile For Input As #1 Cells(i, 1) = Input$(LOF(1), 1) Close #1 i = i + 1 End If Next Application.ScreenUpdating = True End Sub
-
السلام عليكم اخي انظر الى هذا السطر Range("F" & Last & ":N" & Last).AutoFill Destination:=Range("F" & Last & ":N" & Last + 1), Type:=xlFillDefault نسخ السطر الى الاسفل يبدأ من F اي العمود رقم 6 حتي N اي العمود رقم 14 اذا اردت زيادة نطاق النسخ فما عليك سوي تغيير ارقام الاعمدة مثال نريد النسخ من 6 الى 23 ، اي من F الى W يصبح الكود بالشكل التالي Range("F" & Last & ":W" & Last).AutoFill Destination:=Range("F" & Last & ":W" & Last + 1), Type:=xlFillDefault fresh air with macro2.rar
-
السلام عليكم استعمل هذا الكود Sub iAutoFill() Last = Cells(Rows.Count, "F").End(xlUp).Row Range("F" & Last & ":N" & Last).AutoFill Destination:=Range("F" & Last & ":N" & Last + 1), Type:=xlFillDefault End Sub للمحافظة على الترتيب نضيف سطر Range("F" & Last + 1) = Last - 9 فيصبح الكود : Sub iAutoFill() Last = Cells(Rows.Count, "F").End(xlUp).Row Range("F" & Last & ":N" & Last).AutoFill Destination:=Range("F" & Last & ":N" & Last + 1), Type:=xlFillDefault Range("F" & Last + 1) = Last - 9 End Sub