عادل حنفي

السلام عليكم اخي احمد حمور(ابوعبدالله) اشكرك علي المرور و علي كلماتك الطيبة تحياتي

السلام عليكم اخي Kemas عذرا للمرة الثانية ارفع مشاركتي و اجد مشاركتك عن دون قصد فلا تؤاخذي تحياتي

السلام عليكم اخي الفاضل سيكون الكود كالتالي Private Sub CommandButton1_Click() Range("A1") = 9 Sheets(2).Select ActiveSheet.PrintOut End Sub تحياتي

السلام عليكم اخي abo_alaa اخي zine pef اشكركما لكلماتكما و مروركما خالص تحياتي و تقديري

السلام عليكم اخي الفاضل برجاء مراجعة الرابط التالي و اخباري النتيجة اضغط هنــــــــــــــــــــــا تحياتي

السلام عليكم الموضوع تم عمله سابقا و لطلبه مرة اخري وصعوبة ايجاده تم عمله بموضوع منفصل لنتمكن من تطويره حسب ما يطلب و لايجاده بسهوله الملف يقوم بعمل الاتي حفظ الفاتورة فقط برقمها في فولدر ملف الاكسل الاساسي تغير سيريال الفاتوره مسح الفاتوره الاساسية لتجهيزها لفاتورة جديدة حفظ الملف الاساسي تحياتي Save invoice.rar

السلام عليكم اخي الفاضل تقصد انترنت داوناود مانجر فما يلي هو رابط للبرنامج اضغط هنــــــــــــــــــــــا تحياتي

السلام عليكم اكرمك الله اخي Kemas تحياتي

السلام عليكم اخي الفاضل جرب المرفق و اخبرني النتيجة تحياتي Testcolor.rar

السلام عليكم اخي الفاضل جرب المرفق و اخبرني النتيجة تحياتي

بارك الله فيك اخي

بارك الله فيك اخي

السلام عليكم اخي حسن بارك الله فيك و اشكرك علي المرور اخي ajore يتم وضع الكود التالي في حدث التغيير للشيت المقصود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4 Then Cells(Target.Row, 5).Formula = CurrentUser End If كما يتم وضع الكود التالي في مديول منفصل Option Explicit Private Declare Function GetUserName Lib "advapi32.dll" _ Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Public Function CurrentUser() As String Dim strBuff As String * 255 Dim X As Long CurrentUser = "" X = GetUserName(strBuff, Len(strBuff) - 1) If X > 0 Then X = InStr(strBuff, vbNullChar) If X > 0 Then CurrentUser = UCase(Left$(strBuff, X - 1)) 'UCase is optional ;) Else CurrentUser = UCase(Left$(strBuff, X)) End If End If End Function تحياتي

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

السلام عليكم اخي ولد المجرب اخي في الملف الذي به الزر اجعل الوضع في وضع التصميم و اضغط غلي الزر مرتان ليظهر لك كوده لتنسخه وتذهب لملفك و ادرج زر و تضغط عليه مرتان و تلصق ما تم نسخه و يتم ذلك ايضا بالنسبة للزر الاخر ولا تنسي وضع الكود التالي في thisworkbook Private Sub Workbook_Open() Sheets("ورقة1").Range("v1000") = 1 End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Sheets("ورقة1").Range("V1000") = 1 Then If Not Intersect(Target, ActiveSheet.Range("b2:b30,d2:g30")) Is Nothing Then Cells(Target.Row, 1).Select End If End Sub جرب و اخبرني النتيجة تحياتي

السلاام عليكم اخي ايمن الزغبي جرب المرفق تحياتي ID CARD1.rar

السلام عليكم اخي الجزيرة تم القيام بنفس الفكرة من قبل و هي موجودة بالرابط التالي اضغط هنــــــــــــــا تحياتي

السلام عليكم تفضل يا اخي تحياتي Book1.rar

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

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

السلام عليكم اخي قم بضغط الملف اولا ثم قم بالرفع تحياتي

السلام عليكم اخي الفاضل جرب المرفق و اخبرني النتيجة تحياتي Get.rar

السلام عليكم اخي الفاضل بهذا التعديل يتم عمل الكود علي كل اوراق الملف تحياتي Book12.rar

السلام عليكم الاخت الفاضله بتجربة الملف و حسب ما ظهر امامي وجدت مشكلة بالماكرو رقم 5 الموجود بالملف و بالتعديل عليه اظن ان المشكلة اتحلت كما تم ايقاف سطر الترتيب في ماكرو رقم 6 جربي المرفق و اخبريني النتيجة مع ملاحظة ان المرفق ما هو الا نسخ ورقة العمل و الفورم و ماكرو 5 و 6 فقط تحياتي as.rar

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