نجوم المشاركات

تفضل أخى هذا شرح مختصر للكود Sub ragab() 'السطور التالية لتعريف المتغيرات Dim cl As Range, LR As Integer Dim sh As Worksheet, R_N As Integer 'تحديد الورقة التى سوف يتعامل المتغير معها Set sh = ورقة3 '=========================================== 'السطر التالى لوقف اهتزاز الشاشة لتسريع عمل الكود Application.ScreenUpdating = False 'تحديد قيمة خلية رقم السند x = [G13] 'تحديد اول سطر فارغ فى العمود الخاص برقم السند فى الورقة 3 LR = sh.[G1000].End(xlUp).Row + 1 'نسخ الخلايا من ورقة الادخال Range("A13:K13").Copy 'حلقى تكرارية لمعرفة هل رقم السند مكرر داخل الورقة 3 ام لا For Each cl In sh.Range("G13:G" & LR) If cl = x Then 'اذا وجد رقم السند مكرر يتم تحديد رقم الصف الخاص به من السطر التالى R_N = cl.Row 'يتم لصق البيانات الجديدة مكان البيانات القديمة فى الورقة 3 sh.Cells(R_N, 1).PasteSpecial xlPasteValues 'وبعد لصق البيانات الجديدة مكان القديمة يتجة الى السطر الخاص بانهاء خاصية القص والنسخ GoTo 1 End If Next 'اذا لم يكن رقم السند مكرر فيتم نسخة فى صف جديد عن طريق السطر التالى sh.Cells(LR, 1).PasteSpecial xlPasteValues 'السطر الخاص بانهاء خاصية القص والنسخ لازالة التحديد الموجود حول الخلايا المنسوخة 1: Application.CutCopyMode = False ' اعادة اهتزار الشاشة كما كان Application.ScreenUpdating = True End Sub

اقتراح على مسؤولي منتدى أوفيسنا الكرام السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً إن كان يحق لنا ترشيح أحد ليصبح من المشرفين فإنني أقترح عليكم ترشيح أخي الحبيب مختار حسين محمود أرجو أن تأخذوا كلامي هذا بعين الاعتبار لأنني ناصح لمنتدانا ...ثم إنه لن يستطيع الغياب عنا طويلاً كونها مهمة متابعة طلبات إخوته والإتيان بكل ما هو جديد ومفيد والسلام عليكم..

أخي العزيز أيمن إبراهيم ضع الكود التالي في موديول Sub Borders() Dim Rng As Range, Cel As Range Set Rng = Range("B5:B20") Application.ScreenUpdating = False Rng.Borders.LineStyle = xlNone For Each Cel In Rng If Cel.Value <> "" Then With Cel.Resize(1, 6) .Borders.Weight = xlThin: .BorderAround Weight:=xlMedium End With Else Cel.Resize(1, 6).Borders.LineStyle = xlNone End If Next Cel Application.ScreenUpdating = True End Sub وقم بوضع الكود التالي في حدث الورقة الأولى Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 And Target.Row > 4 Then Call Borders End If End Sub تقبل تحياتي

السلام عليكم أخي ياسر العربي شكرا لك وعمل ممتاز أنت بهذه الطريقة (فك حماية الشيت والفيجوال)نتفت ريش الإكسل وكسرت الحماية من الداخل باقي أن تسلخ جلده (إيجاد طريقة لكسر الحماية من الخارج ) ونحن علينا الباقي

اذا كنت تقصد منع تحريك الشكل او تغيير حجمه انظر الصور التالية

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

أخي الكريم محمد إثراءً للموضوع ..إليك الكود بشكل آخر بعيداً عن نسخ ولصق البيانات وبعيداً عن الحلقات التكرارية للبحث عن رقم السند يمكنك إزالة رسائل التنبيه في الكود إذ أنني قمت بوضع تنبيه في حالة أ ن خلية رقم السند فارغة أو تساوي صفر ورسالة تنبيه في حالة إذا كانت البيانات جديدة وترحل لصف جديد ورسالة تنبيه في حالة إذا كانت البيانات موجودة بالفعل ..مع تحديد رقم الصف الذي توجد به البيانات القديمة مع تحياتي لمعلمي الكبير رجب جاويش Sub ReTransferData() Dim Ws As Worksheet, Sh As Worksheet Dim X, lRow As Integer, LR As Integer Set Ws = Sheets("ادخال"): Set Sh = Sheets("كشف") X = Val(Ws.Range("G13").Value) LR = Sh.Cells(Rows.Count, "B").End(xlUp).Row + 1 If X <> 0 Then If Application.IsNA(Application.Match(X, Sh.Columns("G:G"), 0)) Then Sh.Range("B" & LR).Resize(1, 10).Value = Ws.Range("B13").Resize(1, 10).Value MsgBox "New Record", 64 Else lRow = Application.Match(X, Sh.Columns("G:G"), 0) Sh.Range("B" & lRow).Resize(1, 10).Value = Ws.Range("B13").Resize(1, 10).Value MsgBox "Editing Exisitng Record At Row " & lRow, 64 End If Else MsgBox "Receipt Number Should Not Be Empty", vbExclamation: Exit Sub End If End Sub تقبلوا تحياتي

أخى محمد جرب الكود التالى Sub ragab() Dim cl As Range, LR As Integer Dim sh As Worksheet, R_N As Integer Set sh = ورقة3 '=========================================== Application.ScreenUpdating = False x = [G13] LR = sh.[G1000].End(xlUp).Row + 1 Range("A13:K13").Copy For Each cl In sh.Range("G13:G" & LR) If cl = x Then R_N = cl.Row sh.Cells(R_N, 1).PasteSpecial xlPasteValues GoTo 1 End If Next sh.Cells(LR, 1).PasteSpecial xlPasteValues 1: Application.CutCopyMode = False Application.ScreenUpdating = True End Sub ترحيل.rar ترحيل.rar

السلام عليكم ورحمة الله وبركاته أخى أحمد الفلاحجى جزاك الله خيرا أخى و أستاذى الفاضل ياسر خليل جزاك الله خيرا وبعد اذن حضرتك أخى محمد الزريعى تفضل تم عمل المطلوب فى المرفق التالى بعد فك الضغط عن المرفق ستجد ملف + مجلد به ملفات 1 و 2 و 3 الخ كل واحد خاص بموظف ضع هذا المجلد فى البارتش d كما طلبت فى مشاركتك افتح الملف و شغل الكود و كرر التجربة مع تعديل بيانات الموظف ستجد ما تنشده بإذن الله أى استفسار سيكون معك أخوك مختار و أستاذنا ياسر خليل الفارس المغوار تحياتى loop through Excel files in a specified folder and perform a set task on them Mokhtar.rar

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

الــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــله عليك مبدع حتى في اسمك ابدعت فأمتعت "يا سر" قد حللت الاشكال يا سيد الابطال الحمد لله والله يعطيك اكثر مما تسأله بعونه

أخي الحبيب عبد العزيز السر في الاسم (يا سر ...) تقبل وافر تقديري واحترامي

أخي الحبيب رجب جزيت خيراً على كلماتك الرقيقة وما أنا إلا قطرة في بحر علمكم الكبير أيا معلمي ... بارك الله فيك على الاختصار الرائع بالطبع يمكن اختصار الكود كما قدمته لنا في شكل أجمل .. ولكن لي رجاء ألا تنسى الإعلان عن المتغيرات ..لأنه في التعامل مع البيانات الكثيرة والأكواد الكبير يلزم الإعلان عنها للتخفيف على الذكراة أثناء التنفيذ ..نريد أن نعود أنفسنا الخطوات الصحيحة (والكلام موجه لي ولك ولجميع الأعضاء) أمر بسيط وهو تلافي الترحيل في حالة أن رقم الإيصال فارغ أو غير موجود .. من الأفضل احتواء جميع الاحتمالات في الكود تعمدت استخدام رسائل التنبيه التي يمكن الاستغناء عنها لتنبيه المستخدم إذا ما كان السجل تم ترحيله من قبل وهذا تعديل على السابق أو أنه سجل جديد أو أنه لم تتم عملية الترحيل ..ويمكن كما ذكرت الاستغناء عنها لتخفيف الكود أمر آخر بالنسبة للإعلان عن المتغيرات ..صراحة لا أحبذ استخدام اللغة العربية في أسماء المتغيرات أو تعيين قيم المتغيرات إذ أن اللغة العربية تكون مربكة في التعامل مع الكود فأفضل أن يتم الإعلان عن المتغيرات في بداية الكود ثم بدء التعامل معها .. وأفضل تسمية المتعيرات الخاصة بأوراق العمل بأسمائها البرمجية Sheet1 , Sheet2 إلا إذا كانت باللغة العربية ورقة1 و وورقة2 في هذه الحالة أتعامل مع أسماء أوراق العمل بشكل مباشر .. أمر آخر في الكود الأخير الخاص بك .. ماذا لو تم تنفيذ الكود وأنت في ورقة العمل "كشف" بالطبع سيحدث خطأ إذا أنك لم تشر إلى ورقة العمل التي سيتم جلب البيانات منها وهي ورقة "الإدخال" ولن تتم عملية الترحيل بشكل صحيح إلا إذا كنت محدد ورقة العمل "الإدخال" المناقشة ليست للتعديل عليكم لا سمح الله ، ولكن لتكون الأكواد بشكل أصح ويمكن استخدامها على نطاق أوسع في أي ورقة عمل بشكل مرن تقبل وافر تقديري واحترامي

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

خي الكريم سليم أعتقد أن الأمر لا يتعلق بالخلايا الملونة ..إذ أن صاحب الموضوع قال في مشاركته الأولى هذا يعني أن هناك احتمال كبير بوجود التنسيق الشرطي في الأوراق المذكورة .. لم ينبه أحد الأعضاء على صاحب السؤال أن يقوم بإرفاق ملف لتيسير الأمر ... حاولوا تساعدوني في هذا الأمر لأن إرشاد صاحب الموضوع يسهل الوصول للحل بشكل كبير بدلاً من الدخول في دائرة احتمالات وبدلاً من أن نركز في قضية واحدة ومسألة واحد يتشتت الجميع وتذهب الجهود سدى .. تقبلوا تحياتي

السلام عليكم ورحمة الله وبركاته تهـــــــــــــــــانينا الحــــــــــــــارة أخي الحبيب م / ياسر فتحي البنا مباركة عليكم الترقية وإلى المزيد من العمل الصالح الذي نرجو أن يكون لنا ذخراً ليوم تشخص فيه الأبصار والسلام عليكم

بعد اذن أخى الفاضل سليم جرب أخى هذه الفكرة تم عمل قائمة غير مكررة من اسم القرية وخطوط العرض والطول الخاصة بها فى الأعمدة J , K , L وتم عمل قائمة منسدلة فى العمود E كما تريد وعند اختيار اسم القرية يظهر خط الطول وخط العرض تلقائيا فى الخلايا المجاورة ملاحظة : عند وجود قرى جديدة يتم اضافتها واضافة خط العرض وخط الطول الخاص بها فى الأعمدة J , K , L وسوف يتم اضافتها تلقائيا الى القائمة المنسدلة المرنة please 1.rar

استعمل هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 And Target.Row >= 5 And Target.Row <= 20 And Target.Count = 1 Then dd End Sub Sub dd() Dim My_range As Range Dim my_2range As Range Set My_range = Range("b5:g20") My_range.Borders.LineStyle = xlNone For i = 1 To My_range.Rows.Count If My_range.Cells(i, 1) <> "" Then Set my_2range = My_range.Range(Cells(i, 1), Cells(i, 6)) With my_2range.Borders .LineStyle = xlContinuous .Weight = xlThick End With End If Next End Sub

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

وتكون النتيجة كما بالملف المرفق spin.rar

السلام عليكم دالة استخراج تاريخ الميلاد او النوع او المحافظة من الرقم القومي ثلاثة معطيات بدالة واحدة Option Explicit ' بسم الله الرحمن الرحيم ' ******************** ' دالـــــــــــــــة ' Kh_Date_Sex_Province ' ( استخراج تاريخ الميلاد او النوع (ذكر - انثى ' او المحافظة من الرقم القومي '============================================== ' MyTest ' اذا كانت = 1 تقوم باستخراج تاريخ الميلاد ' اذا كانت = 2 تقوم باستخراج النوع ' اذا كانت = 3 تقوم باستخراج المحافظة '---------------------------------------------- ' MyProvinces في متغير الجدول ' العمل لم يستكمل بعد ' يمكنك إضافة المحافظات الاخرى الغير موجودة ' او تعديل الموجود في حالات الخطأ ' بنفس الطريقة الرقم اولا ثم "/" ثم اسم المحافظة ' : مثال على ذلك ' "01/القاهرة" '============================================== '----------------------------------------------------------------- Function Kh_Date_Sex_Province(MyNumber As Variant, MyTest As Byte) Dim MyProvinces As Variant Dim r As Integer Dim yy As String Dim ty As String * 1 Dim d As String * 2, m As String * 2, y As String * 2 _ , x As String * 2, xx As String * 2 '============================================== ' يمكنك إضافة المحافظات الاخرى الغير موجودة ' او تعديل الموجود في حالات الخطأ MyProvinces = Array("01/القاهرة", "02/الإسكندرية", "12/الدقهلية", "13/الشرقية" _ , "14/القليوبية", "15/كفر الشيخ", "16/الغربية", "17/المنوفية", "18/البحيرة" _ , "19/الإسماعيلية", "21/الجيزة", "22/بني سويف", "24/المنيا", "25/أسيوط" _ , "26/سوهاج", "27/قنا", "28/أسوان", "29/الأقصر", "33/مطروح") '============================================== Kh_Date_Sex_Province = "" On Error GoTo 1 If Len(Trim(MyNumber)) = 0 Then GoTo 1 End If If Not IsNumeric(MyNumber) Or Len(MyNumber) <> 14 Then Kh_Date_Sex_Province = "Error_MyNumber" GoTo 1 End If If MyTest = 1 Then d = Mid(MyNumber, 6, 2) m = Mid(MyNumber, 4, 2) y = Mid(MyNumber, 2, 2) ty = Left(MyNumber, 1) Select Case ty Case "2": yy = y Case "3": yy = "20" & y Case Else: yy = "" End Select If yy <> "" Then Kh_Date_Sex_Province = DateSerial(yy, m, d) ElseIf MyTest = 2 Then If Left(Right(MyNumber, 2), 1) Mod 2 = 1 Then _ yy = "ذكر" Else yy = "انثى" Kh_Date_Sex_Province = yy ElseIf MyTest = 3 Then x = Mid(MyNumber, 8, 2) For r = LBound(MyProvinces) To UBound(MyProvinces) xx = MyProvinces(r) If x = xx Then Kh_Date_Sex_Province = Right(MyProvinces(r), Len(MyProvinces(r)) - 3) Exit For End If Next End If 1: End Function بالنسبة لمعطيات المحافظات لم تستكمل بعد ويمكنك اضافة المحافظات المتبقية حسب ما شرحت بالكود خبور خير دالة استخلاص تاريخ الميلاد و النوع و المحافظة من الرقم القومي.rar

بسم الله الرحمن الرحيم بسم الله و الحمدلله و الصلاة و السلام على اشرف خلق الله سيدنا محمد و على آله و صحبة و من والاه أما بعد نظرا لكثرة السؤال عن فك الحماية اما لمحرر الاكواد او لورق العمل قمت بدمج الاكواد مع بعض التعديلات في ملف واحد للتسهيل على الاخوة فقط كل ما عليك هو ان تقر ان الملف خاص بك ولا يعد تعديا علي ملفات الغير يتم تفعيل الازرار الخاصة بكسر حماية محرر الاكواد واوراق العمل كسر حماية اوراق العمل يتم فكها جميعا كل ما عليك هو اختيار الملف والموافقه على بدأ الفك وانتظر حتى يكتمل فك الاوراق جميعا طبعا وقت الفك حسب مدى صعوبة كلمة المرور اما كسر محرر الاكود ما عليك الا ان تقوم باختيار الملف الهدف-xls- فتظهر لك رسالة خطأ بعدها يتم فتح محرر الاكواد ومنها تقوم باعادة تعيين كلمة اخرى والحفظ والسلام عليكم Hack VBA.rar

أخي الكريم مهند لما لا تطرح موضوع جديد لتجد استجابة أكثر مع التوضيح التام لطلبك مع إرفاق لشكل النتائج المتوقعة إذا تطلب الأمر أخي الحبيب رجب جاويش حاول أن تبتعد قدر الإمكان عن الحلقات التكرارية لما لها من أثر في بطء عمل الكود خصوصاً إذا كانت البيانات كبيرة ما رأيك بفكر جديد وهو استخدام خاصية الفلترة ..جرب الكود التالي Sub HideRowsUsingFilterMethod() Dim Rng As Range Application.ScreenUpdating = False On Error Resume Next With ActiveSheet .AutoFilterMode = False .Range("C12:C65512").AutoFilter Field:=1, Criteria1:="=0", Operator:=xlOr, Criteria2:="" Set Rng = .Range("C13:C65512").SpecialCells(xlCellTypeVisible) .AutoFilterMode = False Rng.EntireRow.Hidden = True End With Application.ScreenUpdating = True End Sub تقبل تحياتي

جزاك الله خيرا اخى ياسر ونفعنا الله واياكم وذادكم من فضله وكرمه

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

أخى محمد جرب الكود التالى Sub ragab() Dim rng As Range Dim rng1 As Range Dim cl As Range On Error Resume Next Application.ScreenUpdating = False Set rng = Range("c13:c65512").SpecialCells(xlCellTypeBlanks) rng.EntireRow.Hidden = True Set rng1 = Range("c13:c65512").SpecialCells(xlCellTypeVisible) For Each cl In rng1 If cl.Value = 0 Then cl.EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub الخزينة.rar

المتغير X يشير إلى قيمة الخلية G13 التي بها رقم الإيصال فإذا كان فارغاً أو القيمة صفر ظهرت رسالة بأنه يجب ألا تكون الخلية فارغة وإذا لم لم يكن يساوي صفر ينفذ الكود

أخي الكريم أبو عبد الرحمن على حسب علمي لا يوجد خاصية صناديق الاختيار داخل قائمة الكومبوبوكس جرب الملف التالي عله يكون المطلوب لك ..سيتم إنشاء صناديق اختيار بمجرد تشغيل الفورم .. قم فقط بإنشاء زري أمر أحدهما باسم cmdExit للخروج من الفورم والآخر باسم cmdReport لإظهار الحقول المطلوبة فقط .. أرجو أن يفي بالغرض Private Sub cmdReport_Click() Dim Ctrl As Control, FoundCol Sheet1.Columns("A:T").EntireColumn.Hidden = False Sheet1.Columns("A:R").EntireColumn.Hidden = True For Each Ctrl In UserForm1.Controls If TypeName(Ctrl) = "CheckBox" Then If Ctrl.Value = True Then FoundCol = Application.Match(Ctrl.Caption, Sheet1.Rows(1), 0) If IsNumeric(FoundCol) Then Columns(FoundCol).Hidden = False End If End If Next Ctrl Application.Goto Sheet1.Range("A1") End Sub Private Sub UserForm_Initialize() Dim LastColumn As Long Dim I As Long Dim chkBox As MSForms.CheckBox LastColumn = 18 For I = 1 To LastColumn Set chkBox = Me.Controls.Add("Forms.CheckBox.1", "CheckBox_" & I) chkBox.Caption = Sheet1.Cells(1, I).Value chkBox.Left = 20 chkBox.Top = 5 + ((I - 1) * 20) Next I End Sub Private Sub cmdExit_Click() Unload Me End Sub تقبل تحياتي Create CheckBoxes On UserForm By Cells In Specific Range YasserKhalil.rar

أخى و أستاذى رجب بارك الله فيك و جزاك خيرا أخى و أستاذى ياسر خليل بارك الله فيك و جزاك خيرا

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

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

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

أخى ياسر بجد والله أنا اقف مبهورا أمام ابداعاتك لأتعلم منها وفعلا فكرة جميلة فكرة النقاش لتبادل الخبرات وبالنسبة للكود ما رأيك فى هذا الاختصار Sub ragab() Set Sh = ورقة3 x = [g13] T = Application.Match(x, Sh.Columns("G:G"), 0) If Not IsNumeric(T) Then T = Sh.[G1000].End(xlUp).Row + 1 Sh.Range("B" & T).Resize(1, 10).Value = Range("B13").Resize(1, 10).Value End Sub

أخي الكريم آل سراج أهلاً بك في المنتدى ونورت بين إخوانك لابد من إرفاق ملف للإطلاع عليه ..بشكل مبدئي السطر المحدد في الكود كلمة رقم الإيصال بين كلمة رقم وبين كلمة الإيصال مسافة والمسافات غير مسموح بها في أسماء المتغيرات كما أنني أفضل تسمية المتغيرات باللغة الإنجليزية لسهولة التعامل حيث أن تغيير اتجاه الكتابة مع اللغة العربية يكون مربك في غالب الأحيان تقبل تحياتي

شكرا لك أخى الفاضل مهند وجزاك الله خيرا

اخى خالد جرب الكود الاتى On Error Resume Next del = Application.GetOpenFilename("Excel Files (*.xls), *.xls,(*.xlsm), *.xlsm") Kill (del)

ماشى ياعم ياسر خلينا معاك للاخر بس بالله عليك اهم حاجه خلى بالك من الامتدادات xlsm---xlsb وعلى فكره انت ناصح ودى حاجه احنا كلنا متأكدين منها ليه بقى علشان انت عارف ان الملف مش بيفك xlsm والا مكنتش رفعت الملف بالامتداد ده ياريس على العموم فى طلب تانى ياكبير ......................................... عايزين البرنامج يكون اشمل من كده شويه ويفك الملفات المحميه من الخارج يابقى ورينا الهمه يابوب تقبل تحياتى

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

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

الاخ ياسر الاسطوانة تعمل بدون استدعاء البرنامج الاصلى وياترى المشكلة فى اى اسطوانة الاخيرة ام كله انا جربتها على سفن وانا شغال على 8 وجربتها على اكس بى بتظهر الرسالة التالية باضغط المشكلة فى المثلث انا عندى دائرة العلامة زرقاء وعندك صفراء شفتها لما يكون الوندز فيه عيب فى السيستم

مشكور حبيبي الغالي الاسم الغالي ياسر لمرورك الكريم حمدا لله على السلامة ايه الغيبة الطويلة دي لعله خير باذن الله اخي الغالي ناصر لك كل الشكر والتقدير لكلماتك الجميلة هذه ولك بمثل ما دعوت اما بخصوص طلبك لم افهمه جيدا يرجى توضيح المطلوب ! تقبل تحياتي اخي الغالي محمد على الطيب جزاك الله كل الخير ولك بمثل ما دعوت تقبل فائق احترامي اخي الغالي أبو عيد كل الشكر و التقدير لشخصكم الكريم ولمروركم الجميل وبالهنا والشفا (هنتف ريشة واسلخه واطبخه ) تقبل تحياتي

أخى محمد يرجى توضيح الخطأ الذى يحدث حتى تتم الاستفادة وتلافى هذا الخطأ

أخى الحبيب وأستاذى الكريم // رجب جاويش بارك الله فيكم ، وزادكم الله من فضله ، حفظكم رب العالمين شاكرا لكم كلماتكم الرقيقة فنحن فى هذا المنتدى المبارك نتعلم منكم ( العلم ، وحسن التعامل) وتقبل منى وافر الاحترام والتقدير الأخ الكريم / مهند الزيدى اليكم بالمرفقات نموذج موجود بالمنتدى قمت ببعض التعديلات عليه ، حتى يتوافق مع طلبكم ، وهذا ما أتمناه والشكر موصول لأستاذى الكريم // ياسر العربى وتقبل منى وافر الاحترام والتقدير Names.rar

الشكر لايكفي جعله لله في ميزان حسناتك ورحم الله ولديك

دائما مميز بمواضيعك استاذنا الغالي/ مختار بارك الله فيك وجزاك كل الخير كود جميل والاجمل التوضيح بالملاحظات تقبل تحياتي

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

ده رابط للاستذاده وجزاك الله خيرا اخى رجب

الأخ رجب جاويش .. وفقك الله لكل خير ..شكرا لك

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

الأخ الفاضل أحمد عزيز أهلاً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور للغة العربية .. تقبل تحياتي