بحث مخصص من جوجل فى أوفيسنا
Custom Search
|
-
Posts
1,284 -
تاريخ الانضمام
-
Days Won
6
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
كل منشورات العضو حسين مامون
-
مشكلة في كود تعديل البيانات في اليوسر فورم
حسين مامون replied to شبل ليث's topic in منتدى الاكسيل Excel
اضف هذا السطر للكود في الزر المسمى "تعديل" If TextBox6 = "" Then MsgBox "المرجو ادخال الرمز في المربع الاصفر ": Exit Sub الصورة -
كود ترحيل قيمة أي خلية نشطة الى خلية مجاورة بزيادة واحد
حسين مامون replied to رضوان الشلي's topic in منتدى الاكسيل Excel
اخي الكريم كلنا نعرف عند تنفيذ الماكرو يتم الغاء خاصية التراجع في الاكسيل يمكنك انشاء عمود مساعد لهذه الغاية مثلا اضافة سطر للكود ترحيل قيمة الخلية النشطة ازاحة بمقدار ما يناسب هكذا يحفظ القيمة السابقة ولاسترجاعها انشاء كود بسيط ينقد هذا الامر -
بما انك لم ترفع ملف نمودج عما تريد اليك هاذا الشيء ربما تستفيذ منه listC.xlsm
-
جرب المرفق Private Sub Worksheet_Change(ByVal Target As Range) Dim WS1 As Worksheet: Set WS1 = Sheets("Vacation_Registor") WS1.ListObjects("الجدول520").Range.AutoFilter Field:=1 WS1.ListObjects("الجدول520").Range.AutoFilter Field:=5 Dim RG1, RG, RG2 Dim lr1, lr Dim x Application.ScreenUpdating = False If [c2] = "" Then MsgBox "المرجو اختيار الاسم اولا": Exit Sub If Not Intersect(Target, Range("c3")) Is Nothing Then '==================== Set RG1 = ListObjects("الجدول119").Range lr1 = RG1.Find(WHAT:="*", AFTER:=RG1.Cells(1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, _ searchdirection:=xlPrevious, MatchCase:=False).Row + 1 Range("b5:e64").ClearContents '==================== WS1.Range("a2:g2").AutoFilter WS1.ListObjects("الجدول520").Range.AutoFilter Field:=1, Criteria1:=Range("c2") WS1.ListObjects("الجدول520").Range.AutoFilter Field:=5, Criteria1:=Target '==================== Set RG = WS1.ListObjects("الجدول520").Range lr = RG.Find(WHAT:="*", AFTER:=RG.Cells(1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, _ searchdirection:=xlPrevious, MatchCase:=False).Row If lr = 2 Then Exit Sub WS1.Range("b3:e" & lr).Copy Range("b5").PasteSpecial ' Range("a5:a" & lr + 1).Formula = "=IF(B5="""","""",SUBTOTAL(103,$B$5:B5))" WS1.ListObjects("الجدول520").Range.AutoFilter Field:=1 WS1.ListObjects("الجدول520").Range.AutoFilter Field:=5 End If Application.ScreenUpdating = True End Sub الملف تجربة 1 (1) (1).xlsm
-
ادخل بعض البيانات في الشيت كما تتصورها ثم ارفعه والله المستعان
-
اخي الكريم اعطينا هذا الموضوع اكثر مما يستحق وهذا مخالف لقانون المنتدى وكل هذا لانك لم توصل الفكرة عما تريد بلغة الاكسيل لاخر مشاركة ارجو ان تشرح ما دور الكود الدي تتحدث عنه ادا طبق ايعمل على العمودE الكود في مشاركتي السابقة يغي بالغرض وينبهك في بملاحضة بالعمود F انسخه وضعه في حدثworkbook_open ارجو بعض الاخوة الاطلاع على الملف وابداء اراء لان الاخ يقول الملف لايفتح عنده تحياتي
-
الكود الاول في حدث Workbook_Open وهو يفعل كود test2 ثم يخفي الاكسيل ويظهر الفورم Private Sub Workbook_Open() test2 Application.Visible = False UserForm1.Show End Sub وهذه صورة الكود داخل محرر الاكواد وهذه الاكواد داخل الفورم Private Sub CommandButton1_Click() ThisWorkbook.Save Application.Quit End Sub Private Sub CommandButton2_Click() Unload Me Application.Visible = True Sheets(1).Activate End Sub صورة الفورم وهذا الكود في مديول Sub test2() Dim lr Dim x, m lr = Cells(Rows.Count, "d").End(3).Row For x = 3 To lr Dim DT1, DT2 If CDate(Cells(x, "e")) = Date Then Cells(x, "f").Value = "هذا الشيك حان موعده" Cells(x, "f").Interior.Color = 255 Else Cells(x, "f").Interior.Color = xlNone Cells(x, "f").Value = "" End If Next x وهذه صور للصفحة
-
حافظه شيكات.xlsm
-
حافظه شيكات.xlsm عندي شغال 100/100 وهذه صورة هذا الكود انسخه الى ملفك Sub test2() Dim lr Dim x, m lr = Cells(Rows.Count, "d").End(3).Row For x = 3 To lr Dim DT1, DT2 If CDate(Cells(x, "e")) = Date Then Cells(x, "f").Value = "هذا الشيك حان موعده" Cells(x, "f").Interior.Color = 255 Else Cells(x, "f").Interior.Color = xlNone Cells(x, "f").Value = "" End If Next x End Sub
-
جرب هذا حافظه شيكات.xlsm
-
هل تقصد انك تريد كود vba لتنبيه عند انتهاء التاريخ المحدد في العمود E?
-
اخي الكريم ملفك ينقصه مزيدا من الشرح لما تقصد هذا طلبك الاول ولكن لم افهم فيه شيء تقوا تريد ان يكون التطبيق على التواريخ في العمود E ولكن كيف؟ ١ الشرح كان على خانه واحدة فى عمود (e5 )اريد ان يكون التطبيق على التواريخ الموجوده فى العمود( e) بالكامل اشرح ما تريد بالتفصيل بالنسبة للطلب الثاني انسخ هذا الكود وضعه في الزر لي في الفورم Private Sub CommandButton2_Click() Unload Me Sheets(1).Activate End Sub
-
كود ترحيل قيمة أي خلية نشطة الى خلية مجاورة بزيادة واحد
حسين مامون replied to رضوان الشلي's topic in منتدى الاكسيل Excel
استعمل هذا الكود واكتفي بزر واحد فقط Sub RN() If Not Intersect(Columns(3), ActiveCell) Is Nothing Then If ActiveCell = "" Then Exit Sub ActiveCell.Offset(, 1) = Val(ActiveCell + 1) '======= ElseIf Not Intersect(Columns(5), ActiveCell) Is Nothing Then If ActiveCell = "" Then Exit Sub ActiveCell = "x" & ActiveCell ActiveCell.Offset(, 8) = "x" '======= ElseIf Not Intersect(Columns(8), ActiveCell) Is Nothing Then If ActiveCell = "" Then Exit Sub ActiveCell.Offset(, 1) = ActiveCell ActiveCell = "x" & ActiveCell '======= ElseIf Not Intersect(Columns(10), ActiveCell) Is Nothing Then If ActiveCell = "" Then Exit Sub ActiveCell.Offset(, 4) = "x" ActiveCell = "x" & ActiveCell End If End Sub الترحيل بالماكرو (1).xlsb -
كود ترحيل قيمة أي خلية نشطة الى خلية مجاورة بزيادة واحد
حسين مامون replied to رضوان الشلي's topic in منتدى الاكسيل Excel
الترحيل بالماكرو (1).xlsb -
كود ترحيل قيمة أي خلية نشطة الى خلية مجاورة بزيادة واحد
حسين مامون replied to رضوان الشلي's topic in منتدى الاكسيل Excel
مرحبا اخي الكريم جرب المرفق الترحيل بالماكرو.xlsb -
كود ترحيل قيمة أي خلية نشطة الى خلية مجاورة بزيادة واحد
حسين مامون replied to رضوان الشلي's topic in منتدى الاكسيل Excel
Sub test1() If Not Intersect(Columns(3), ActiveCell) Is Nothing Then If ActiveCell = "" Then Exit Sub ActiveCell.Offset(, 1) = Val(ActiveCell + 1) ActiveCell.Offset(, 3) = Val(ActiveCell + 1) End If End Sub Sub test2() If Not Intersect(Columns(8), ActiveCell) Is Nothing Then If ActiveCell = "" Then Exit Sub ActiveCell.Offset(, 1) = Val(ActiveCell) ActiveCell.Offset(, 3) = Val(ActiveCell) If ActiveCell = 40 Then ActiveCell = ActiveCell & "x" End If End Sub -
كود ترحيل قيمة أي خلية نشطة الى خلية مجاورة بزيادة واحد
حسين مامون replied to رضوان الشلي's topic in منتدى الاكسيل Excel
جربهدا نشط اي خلي عي العمود c او h Sub test1() If Not Intersect(Columns(3), ActiveCell) Is Nothing Then If ActiveCell = "" Then Exit Sub ActiveCell.Offset(, 1) = Val(ActiveCell + 1) End If End Sub Sub test2() If Not Intersect(Columns(8), ActiveCell) Is Nothing Then If ActiveCell = "" Then Exit Sub ActiveCell.Offset(, 1) = Val(ActiveCell) End If End Sub كود ترحيل قيمة أي خلية نشطة الى خلية مجاورة بزيادة واحد.xlsm -
كود لعدم تأثر أو تغيير أسعار المدخلات القديمة عند تحديث الأسعار
حسين مامون replied to أستيكا's topic in منتدى الاكسيل Excel
جرب هذا الشيء Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim WS2 As Worksheet Set WS2 = Sheets("Price list Gouna") Dim RG, lr Dim x, RT Set RG = WS2.ListObjects("Table2").Range Set RT = ActiveSheet.Range("k3:k120000") lr = RG.Find(WHAT:="*", AFTER:=RG.Cells(1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, _ searchdirection:=xlPrevious, MatchCase:=False).Row '================== If Not Intersect(Target, RT) Is Nothing Then For x = 3 To lr If WS2.Cells(x, 1).Text = Target Then Target.Offset(, -1).Value = WS2.Cells(x, 3).Value Target.Offset(, -3).Value = WS2.Cells(x, 2).Value Exit For End If Next x End If End Sub 1096400303_test(5).xlsm -
اخي الكريم يمكن لاسم واحد ان يتكرر ايضا في اجازتين والتاريخ كذلك يمكن ان يتكرر فلا ار ى هذا حلا لموضوعك ما رايك في اضافة عمود يسمى "رقم الاجازة" وكل اججازة تحمل رقم ويتغير في الطلب بعد كل ترحيل انظر المرفق تجربة 1 (1).xlsm
-
جرب المرفق تجربة 1 (1).xlsm
-
-
تجربة بالنسبة للترحيل من شيت Vacation Letter الى Vacation_Registor اتمنى ان يكون ما تريد تجربة 1 (1).xlsm
-
ربما تقصد هذا استعلام رقم الجلوس.xls
-
ارفعي صورة عن الخطأ واشرحي المطلوب بالظبط
-
انسخي هذا الكوذ الى الزر الذي تريدين وضعيه بين السطرين Private Sub CommandButton2_Click() و end sub الكود بسيط يمكنك التعديل عليه حسب السكستبوكس او العمود المرحل اليه اضيفي تسكستبوك الذي تريدين Dim lr lr = Cells(Rows.Count, 2).End(3).Row + 1 Range("b" & lr).Value = TextBox4.Value Range("c" & lr).Value = TextBox5.Value Range("d" & lr).Value = TextBox6.Value TextBox4 = "" TextBox5 = "" TextBox6 = ""