ابو اسامة العينبوسي

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

السلام عليكم نعم ممكن ضع تصور الملف و نعمل الازم

السلام عليكم ضع اى ملف PDF في My Documentsو سمه "Test" Sub test() On Error Resume Next Filename = Range("A1").Value ThisWorkbook.FollowHyperlink "C:\Documents and Settings\User\My Documents\" & Filename & ".pdf" End Sub test1.rar

السلام عليكم اهلا بك و مشكور على الملف الجميل

شكرا على المعلومه استاذ احمد

السلام عليكم اخى justic حتى يكون الموضوع اشمل اليك الملف التالى Private Sub UserForm_Initialize() Dim My_Names As Names Set My_Names = ActiveWorkbook.Names With Me.ComboBox1 For i = 1 To Names.Count .AddItem Names(i).Name Next i End With End Sub ايضا Sub Get_Names() Dim My_Names As Names Set My_Names = ActiveWorkbook.Names For i = 1 To Names.Count Cells(i, 4) = My_Names(i).Name Next i End Sub My_Names.rar

السلام عليكم احسنت استاذ هادى لكن في حال كانت البيانات غير متجاورة(منقطعة التواصل) ممكن تستخدم الاتى Sub DOIT2() ActiveSheet.Rows(Sheets("Sheet1").UsedRange.Rows.Count).Select End Sub Row2.rar

السلام عليكم sum_All_A1__s.rar

السلام عليكم بورك فيك اخى معلومه مفيده

السلام عليكم موضوعك غامض قليلا اذا كان المقصود تلوين المكرررات يكون هكذا باتنسيق الشرطى test_it.rar

http://www.officena.net/ib/index.php?showtopic=27386

السلام عليكم Private Sub ComboBox1_Click() x = Sheets.Count For i = 4 To x Sheets(i).Cells(1, 1) = Me.ComboBox1.Value Next i End Sub Private Sub ComboBox2_Click() x = Sheets.Count For i = 4 To x Sheets(i).Cells(1, 1) = Me.ComboBox2.Value Next i End Sub Private Sub UserForm_Initialize() With Me.ComboBox1 For x = 1 To 10 .AddItem Sheets(1).Cells(x, 1) Next x End With ComboBox2.RowSource = "b1:b10" End Sub comboboxs.rar

السلام عليكم ردودى تكو ن على عجل لانى اكون في العمل لوحدى لذلك تكون بحاجه الى تنقيح هنا الكود معدل و اسرع my_Opinion2.rar

الاخ tofimoon ممكن تضع الاتى Range(Cells(3, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).ClearContents اما تضعه في الموديل او تضيفه الى زر الامر Collect

السلام عليكم Sub sheet_collec() For i = 1 To Sheets.Count - 1 Worksheets("" & i).Select T = 3 Do While T < ActiveSheet.UsedRange.Rows.Count + 1 R1 = Sheets("total").Cells(65000, 1).End(xlUp).Row + 1 Sheets("total").Cells(R1, 1) = ActiveSheet.Cells(T, 2) If ActiveSheet.Cells(T, 6) = "" Then Sheets("total").Cells(R1, 2) = 0 Else Sheets("total").Cells(R1, 2) = ActiveSheet.Cells(T, 6) End If If ActiveSheet.Cells(T, 7) = "" Then Sheets("total").Cells(R1, 3) = 0 Else Sheets("total").Cells(R1, 3) = ActiveSheet.Cells(T, 7) End If T = T + 1 Loop Application.StatusBar = "يتم الان ترحيل الورقة" & ActiveSheet.Name Next i Sheets("total").Select End Sub [code] كود اخر [code] Sub sheet_collect2() TR = 2 For i = 1 To Sheets.Count - 1 Worksheets("" & i).Select For x = TR To ActiveSheet.UsedRange.Rows.Count R1 = Sheets("total").Cells(65000, 1).End(xlUp).Row + 1 Sheets("total").Cells(R1, 1) = ActiveSheet.Cells(x, 1) Next x Next i End Sub my_Opinion.rar

السلام عليكم اخى عادل ممكن اختصار الكود بالاتى Private Sub TextBox1_Change() If Not IsNumeric(Me.TextBox1) Then Me.TextBox1 = "" End Sub لكن في حال تم كتابه ارقام ثم احرف يمسح كل محتويات التكست بوكس

السلام عليكم تعديل بسيط على كود الاستاذ اكسلجى(و حشنا كثير) ليكون اسرع Sub delet_if_not_equal() Dim D As Variant Application.ScreenUpdating = False Application.Calculation = xlCalculationManual D = InputBox("أدخل البيان الذي لا تريد إلغاؤه", "أدخال البيان المراد عدم إلغاؤه") For i = 2 To Cells.Rows.Count If Cells(i, 4) <> D Then Cells(i, 4) = "" Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub

السلام عليكم ممكن عن طريق بحث و استبدال استبدل الكلمات المراد الغاؤها بـ ""

السلام عليكم الان الزرين يعملان (في ورقة4) مع تبديل لا خفاء الزرين Sub hidde() Worksheets(4).Shapes("Rectangle 1").Visible = False Worksheets(4).Shapes("omr").Visible = True x = 1 For i = 2 To Cells(65000, 2).End(xlUp).Row If Cells(i, 2) = 0 Then Cells(i, 2).EntireRow.Hidden = True Else Cells(i, 1) = x x = x + 1 End If Next i End Sub ------------------------------------------------------------------------------- Sub unhidde() Worksheets(4).Shapes("Rectangle 1").Visible = True Worksheets(4).Shapes("omr").Visible = False For i = 2 To Cells(65000, 2).End(xlUp).Row If Cells(i, 2).EntireRow.Hidden = True Then Cells(i, 2).EntireRow.Hidden = False Cells(i, 1) = i End If Next i For i = 2 To Cells(65000, 2).End(xlUp).Row Cells(i, 1) = i - 1 Next i End Sub ______________________________________F2.rar

السلام عليكم كيف ستقوم بالادخال في صف مخفى(حسب فهمى لطرحك)؟؟

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

السلام عليكم ممكن ان ترسم شكل من شريط ادوات الرسم و من ثم كبسه باليمين على الشكل اختر > تعيين ماكرو

السلام عليكم بالنسبه لتشغيل الكود عند فتح الملف كود الاخفاء Private Sub Workbook_Open() cell hidde End Sub كود الاظهار Private Sub Workbook_Open() cell unhidde End Sub وهنا الكود كامل Sub hidde() x = 1 For i = 1 To Cells(65000, 2).End(xlUp).Row If Cells(i, 2) = 0 Then Cells(i, 2).EntireRow.Hidden = True Else Cells(i, 1) = x x = x + 1 End If Next i End Sub Sub unhidde() For i = 1 To Cells(65000, 2).End(xlUp).Row If Cells(i, 2).EntireRow.Hidden = True Then Cells(i, 2).EntireRow.Hidden = False End If Next i For i = 1 To Cells(65000, 2).End(xlUp).Row Cells(i, 1) = i Next i End Sub hide2.rar

السلام عليكم عساه المطلوب Sub hidde() x = 1 For i = 1 To 10 If Cells(i, 2) = 0 Then Cells(i, 2).EntireRow.Hidden = True Else Cells(i, 1) = x x = x + 1 End If Next i End Sub hide.rar

السلام عليكم احسنتم احسنت اخى New4a تقصد هكذا =SUM(A1:C1)