abouelhassan

استاذ على حفظك الله بعد اذنك يمكن استخدام حدث change بدون زر فى حدث الصفحة ليصبح الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets sh.Columns.AutoFit sh.Rows.AutoFit Next sh End Sub مع الشكر

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

بارك الله فيك استاذ اجمد ربنا يحفظك اللهم امين

السادة الاخوة اصدقائى الافاضل كل الاحترام من القلب لدى عدد 7 شيتس بكل منها عدد 19 عامود تحمل نفس الاسم اريد كود ترحيل المبلغ الى الشيت الذى امامه وكذلك اسم الشيت قمت بعمل قائمة منسدلة لاختيار اسم العمود متها واسم الشيت المراد الترحيل المبلغ اليه بدأ من الشيت ص ص والشرح بالملف كل الشكر والتقدير والاحترام من اخيكم ترحيل2.xlsm

رائع استاذنا الفاضل بارك الله فيك

استاذنك استاذ سليم لمعالجة هذا الموضوع يجب مسح الحقول بعد عملية الحفظ ويتم تغير هذا الجزء من الكود Private Sub BT_SAVE_Click() Dim old_num Set sh = Sheets("Sheet1") last = sh.Cells(Rows.Count, 1).End(3).Row If last = 1 Then Exit Sub sh.Range("A2:G" & last).Interior.ColorIndex = 35 If Me.T_NewMASROUF.Value = "" Then MsgBox "الرجاء تحديد المصروف الجديد قي الخانة المناسبة", _ vbMsgBoxRtlReading Exit Sub End If old_num = LB_Kadim.Caption With Me.ListBox1 If .ListIndex < 2 Then Exit Sub x = .List(.ListIndex, 7) sh.Cells(x, 7) = Me.T_NewMASROUF.Value .List(.ListIndex, 0) = Me.T_NewMASROUF.Value End With Me.ListBox1.ListIndex = -1 Me.LB_Kadim.Caption = old_num sh.Cells(x, 1).Resize(, 7).Interior.ColorIndex = 40 Application.Goto sh.Cells(x, 1) Me.T_CODE = "" Me.T_KOUMI = "" Me.LB_Kadim = "" Me.T_NewMASROUF = "" End Sub اخر اربع اسطر مسئولين عن مسح الحقول سامحنى استاذى سليم ا اقصد الا المساعدة لوجه الله احترامى لشخصك الكريم

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

كل الشكر والتقدير والاحترام من القلب

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

جرب هذا data Validation.xlsx

تسلم ايدك استاذنا الفاضل سليم اللهم انصر لبنان اللهم امين

يمكنك استخدام هذا الكود اخى Sub towmacro() Application.ScreenUpdating = False PrintAllFirstPage Export_PDF_in_OneAll Application.ScreenUpdating = True MsgBox "Done" End Sub

زادك الله علما استاذ سليم تحف ودرر وروائع وكل حاجة حلوة تسلم ايدك

مشكور استاذنا

تسلم ايدك استاذنا

حضرتك رائع والله رجل المهام الصعبة ادام الله عزك وعلمك اخى فى الله استاذ سليم

هذا الموضوع طرحه الاستاذ شوقى ربيعشوقي ربيع فى هذا الموضوع لدى ملف ليس به فورم واريد الاستفادة من هذا الموضوع بان يقوم الاكسيس كمخزن معلومات والاكسيل كما هو ممكن شرح لو امكن انا اضفت الاكواد لملفى ولم يحدث شئ مع الشكر والتقدير ex&acc.rar

انا هارسل لحضرتك رابط به كل الملفات التى قمت بتحميلها وهى كلها لحضرتك لو حضرتك حابب انى اجمع الاكواد فى محفظة اكواد تحت امرك بس انا كاتب على كل ملف وظيفة الكود عموما هبعت لحضرتك الرابط واى شئ تأمرنى به سافعله اخيك باحترام

حاضر استاذى سأقوم برفع كل الاكواد بارك الله فيك

والله العظيم ما فى كود لحضرتك استاذ سليم الا وباخد منه نسخة فى مكتبة الاكواد الخاصة بى لان هذه الاكواد كنوز فتح الله عليك وبارك لك احترام وتقدير من اخيك

شكر تقدير واحترام من اخيك

ارفع ملف بطلبك لعلك تجد حل من عباقرة المنتدى

جرب هذا الحل للاستاذ ياسر خليل ياسر خليل أبو البراء له التحية احترامى med.mashroo3.xlsm

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

السلام عليكم ورحمة الله كل عام وحراتكم بخير هذا الملف تصميم استاذى سليم حاصبيا احتاج تعديل تم عمل قائمة منسدلة بها 3 جمل-كلمات او جملة جمع الكل وفى هذه الحالة الكود يظل كما هو حاليا يؤدى مهمته الحالية 2-الارقام السالبة اريده ان يستدعى الارقام التى اقل من صفر 3-الارقام الموجبة اريده ان يستدعى الارقام اكبر من صفر مع خالص دعائى وشكرى وعرفانى بالجميل اخيكم باحترام Sub Trasfer_data_Special() Dim R As Worksheet, Act_sh As Worksheet Dim k%, col%, Ro% Dim Max_ro%, x%, y% Dim Bol As Boolean Dim ST_Dat As Date Dim End_Dat As Date Dim My_sum# Dim Mot$ Mot = "الاجمالى" Set R = Sheets("Report_Youmi") Ro = R.Cells(Rows.Count, 1).End(3).Row R.Range("C3").CurrentRegion.Resize(Ro - 1).ClearContents R.Cells(3, 9).Resize(Ro - 2).ClearContents ST_Dat = Application.Min(R.Range("I2:J2")) End_Dat = Application.Max(R.Range("I2:J2")) For k = 3 To Ro - 2 Bol = Application.Evaluate _ ("ISREF('" & R.Range("A" & k) & "'!A1)") If Bol Then Set Act_sh = Sheets(R.Range("A" & k) & "") Max_ro = Act_sh.Cells(Rows.Count, 1).End(3).Row For y = 3 To 7 For x = 5 To Max_ro If CDate(Act_sh.Cells(x, 1)) >= ST_Dat And _ CDate(Act_sh.Cells(x, 1)) <= End_Dat And _ Act_sh.Cells(x, 2) <> Mot Then My_sum = My_sum + IIf(IsNumeric(Act_sh.Cells(x, y + 2)), _ Act_sh.Cells(x, y + 2), 0) End If Next x R.Cells(k, y).Value = IIf(My_sum = 0, "", My_sum): My_sum = 0 Next y End If Next k '+++++++++++++++++++++++++++++++++ R.Cells(Ro - 1, 3).Resize(, 5).Formula = _ "=if(COUNT(C$4:C$39)>0,SUM(C$4:C$39),"""")" R.Cells(Ro, 3).Resize(, 5).Formula = _ "=IF(COUNT(C$7:C$17)>0,SUM(C$7:C$17),"""")" R.Cells(4, 9).Resize(Ro - 3).Formula = _ "=IF(COUNT($C4:$G4)>0,SUM($C4:$G4),"""")" R.Range("A3:I" & Ro).Value = _ R.Range("A3:I" & Ro).Value End Sub My_Repport_Updated.xlsm