طارق محمود

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

السلام عليكم أخي العزيز مرفق ملف القيود ومعه كود يتم تشغيله من الزر الأخضر (ازدواجية) أعلي الورقة علي أن تقف في السطر المراد عمل ازدواجية له Sub Macro1() ' ' Macro1 Macro ' rrw = ActiveCell.Row a = Cells(rrw, 3).Value 'Credit b = Cells(rrw, 4).Value 'Debit c = Cells(rrw, 5).Value 'Explain If WorksheetFunction.CountA(Range(Cells(rrw, 3), Cells(rrw, 5))) < 2 Then MsgBox ("No enough Data"): Exit Sub Range("E1000").Select Selection.End(xlUp).Select ActiveCell.Offset(1, 0).Select ActiveCell.Value = c If a = 0 And b > 0 Then ActiveCell.Offset(0, -2).Value = b If b = 0 And a > 0 Then ActiveCell.Offset(0, -1).Value = a End Sub يعتمد الكود عليأن يكون في السطر بيانين علي الأقل وإلا يرجع لك برسالة No enough Data يقرأ الكود ثلاث بيانات المبلغ دائن و مدين والشرح ثم ينقل الشرح لآخر سطر فاضي أما المبلغ فإذا كان دائن يتم نقله للمدين والعكس وطبعا إنت لازم تحدد إسم الطرف الآخر دائن / مدين تفضل المرفق قيود.rar

أكيد فيه أكثر من حل ولكني للأسف لست محاسبا وإلا كنت سهلت عليك كثيرا فقط إرسل لي نسخة من ورقة قيد واحدة بها 5 بيانات علي الأقل مع تكرارها وتوكل علي الله

السلام عليكم لاأفهم ماتقصد ، المفروض أن هذا هو الحال فعلا المفروض أن يتم تغيير المحتوي بناءا علي التعديلات التي عدلتهل علي الملف مثلا كود سند الصرف سطر المراجعة : If WorksheetFunction.CountA("D9, E12, E14, D15, H10, I10, I12") <> 7 Then Exit Sub أي أن الخلايا E12 , M15 , IV10 , C14 , D9 , E13 لابد أن تكون بها بيانات وإلا سيخرج من الماكرو ولكن الواقع أن الخلايا : E2 , C8 , H8 , C13 , IV1 , C10 , E5 , A2 , I10 , A3 , A4 , IV4 , G10 هي التي لابد أن تراجع عليها علي الفورمات الجديدة فيكون الكود كالتالي If WorksheetFunction.CountA("E2, C8, H8, C13, IV1, C10, E5, A2, I10, A3, A4, IV4, G10") <> 13 Then Exit Sub

السلام عليكم إخواني الأعزاء هذا الكود أيضا تظلل مجال في الصفحة قبل تنفيذه ويقوم بعمليتين 1. محو البيانات فقط من أرقام ونصوص للمجال المحدد (مع الإحتفاظ بالتنسيق والفورمات) 2. الإحتفاظ بمجموع الأرقام إن وجدت في الخلية النشطة وإلا يعطي صفرا تفضلوا Sub Summ_t() x = Application.WorksheetFunction.Sum(Selection) Selection.ClearContents ActiveCell.Value = x End Sub

السلام عليكم تفضل المرفق ويمكنك سحب المعادلة إلي نهاية العمود كما تحب x8.rar

السلام عليكم ممكن ياأخي يوجد بالإكسل خاصية تخزين بصيغة تيكست والأفضل منها كان في إصدار 2003 خاصية تخزين بصيغة dbf والتي تجعل لكل عمود عنوان إجباري في الملف (dbf)

وبالنسبة لسؤالك في الملف : ورقة مبيعات أعتقد أنك غيرت في الكود بما يسبب عطل الكود والدوران في لووب لا نهائي عند السطر 450 450 x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME5 Then GoTo 450 Next i إذا استطعت انت تصليحه يكون أفضل

بالنسبة لسؤالك في الملف : ورقة سند قبض نعم يمكنك ذلك عن طريق تغيير الكود Range("IV4").Value = Range("IV4").Value + 1 إلي n_ser = n_ser + 1 Range("IV4").Value = "M1-2010- " & 1429 + n_ser حيث الرقم 1429 في الكود هو الذي سيزيد 1 كلما تمت عملية الترحيل

أخي تقول في الملف : ورقة قيود كنا إنتهينا من هذا سابقا علي ماأذكر عن طريق الـ Data > Validation أرجو التوضيح أكثر

السلام عليكم أخي العزيز أول تعديل في ورقتي الصرف والقيد لعمل مراجعة أوتوماتيكية قبل الترحيل السطر الذي نصحتك بإضافته أول الكود كان فيه عن طريق الخطأ حرف E ناقص في كلمة Exit الصحيح هو If WorksheetFunction.CountA("E12,M15,IV10,C14,D9,E13") <> 6 Then Exit Sub

السلام عليكم أخي زياد أنا علي سبيل المثال عندي مجموعة أكواد صغيرة وأعتقد أن كثير من الإخوة اعضاء المنتدي لهم أكواد صغيرة خاصة بهم تم تفصيلها لتناسب حاجاتهم وطبيعة عملهم قد يكون الكود غاية في الصغر ولكنه مفيد وعلي هذا المنوال أخصص لكل من هذه الأكواد shortcut key فهذا ctrl-k وذاك ctrl-j طبعا غير الكابيتال ctrl-K; ctrl-J أضعها كلها في ملف Personal يتم فتحه أوتوماتيكيا مع الإكسل المهم أود المساهمة بكود يمكن إستخدامه كثيرا لمن يستعمل اللغة الإنجليزية يحول حالة الأحرف داخل المجال الذي تم إختياره إلي حالة عنوان (أي كابيتال لأول حرف من كل كلمة) المعروف أن الدالة Proper في الإكسل تقوم بنفس الوظيفة ولكن إذا كانت البيانات المطلوب تحويلها في أماكن غير منظمة فهذا الكود يكون أسرع واكثر إستخداما فإذا خصصت له مثلا ctrl-j ثم تظلل المجال وتضغط ctrl-j عذرا للإطالة وهذا هو الكود Sub Adj_Proper() For Each se In Selection se.Value = WorksheetFunction.Proper(se) Next End Sub

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

السلام عليكم أخي الحبيب يبدو من السؤال أنك تريد تعلم الفيجوال بيزيك وهي لغة البرمجة التي تستطيع من خلالها عمل الماكرو يلزمك بعض الصبر والمثابرة وأنصح بالإستعانة بموضوع مرتب في هذا المجال وليكن موضوع "شرح الماكرو و القوائم بالصور" للأستاذ العملاق /هادى محمد المامون سالم فلتتجه إلي الرابط التالي وستجد مايسرك إن شاء الله http://www.officena.net/ib/index.php?showtopic=12203&st=0 أو انقر هـــنا

السلام عليكم أخي لحبيب أود والله من كل قلبي مساعدتك ولكني أعاني الأمرين في موضوع اللغة العربية وأيضا مشغول شوية وسأضع رابط الموضوع السابق هنا http://www.officena.net/ib/index.php?showtopic=31525&st=0&p=160431&fromsearch=1&#entry160431 لعل أحد الخبراء يحل لي موضوع اللغة العربية في جهازي ومن ناحيتك أنت مرة أخري غير كل الأكواد للإنجليزية ولاتجعلها بالعربي إلا بعد تضبيط كل شء بإذن الله

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

السلام عليكم ماشاء الله أخي زياد بوركت وبورك مسعاك وفقك الله لمزيد من الخير والنفع

السلام عليكم أختنا الفاضلة مرفق ملف به الكود ومضاف إليه أيضا الوقت الحالي في الخلية: J1 هذا بالشييت الأول وفي الشييت الثاني شرح لموضوع أكبر رقم تفضلي المرفق nour.rar

السلام عليكم أختنا العزيزة يتوقف هذا علي طريقة القراءة والكود لكنها في جميع الأحوال لاتتجاوز ثواني قليلة بفرض ان البيانات موجودة في المجال من C3 إلي V52 يعني 20 عمود ، 50 صف ففيما يلي كود يقرأ ويسجل وقت قبل البدأ في قراءة في الخلية C1 ثم يعيد طباعتها بداية من الخلية C61 ويسجل وقت الإنتهاء في الخلية G1 Sub sss() Dim a(50, 20) Range("B2").Select ' Start Reading Range("c1").Value = Now For i = 1 To 50 For j = 1 To 20 a(i, j) = ActiveCell.Offset(i, j).Value Next j Next i ' Start Printing Range("B60").Select For i = 1 To 50 For j = 1 To 20 ActiveCell.Offset(i, j).Value = a(i, j) Next j Next i Range("g1").Value = Now Range("A1").Select End Sub

أنا لاحظت أنك ماشاء الله تستطيع التعديل وتطويع الملف لما يناسب إحتياجاتك لذلك سأساعدك فقط بالفكرة وأترك العمل لك أولا: مثلا يمكنك عمل مراجعة أوتوماتيكية قبل الترحيل عن طريق عد البيانات في الخلايا الصفراء أو المدخلات بدون الخلايا التي بها معادلات مثلا إسم الدائن والمدين ولاداعي لأرقام حساباتهم لأنها أوتوماتيكية بمعني آخر البيانات في سند الصرف لابد أن تكون 6 بيانات فقط وهي s_name1 = Range("E12").Value s_name2 = Range("M15").Value s_explain2 = Range("IV10").Value s_amount = Range("C14").Value s_date = Range("D9").Value S_DUL = Range("E13").Value ممكن تضيف في أول الكود السطر التالي If WorksheetFunction.Counta("E12,M15,IV10,C14,D9,E13") <> 6 then exit sub

السلام عليكم تظلل الحقول المراد عمل الكنترول عليها وتختار Data Validation Custom وبفرض ان الخلية النشطة في التظليل هي D3 فتكتب المعادلة التالية في الــ Custom =ISERROR(SEARCH(" ";D3))=TRUE

أخي وصديقي الحبيب / أحمد بالطبع يمكن عمل ذلك من خلال ِadd-ins جزاك الله خيرا

أين هي يأستاذ بالمناسبة: هل أنت طارق حنيدق - قطر؟

السلام عليكم أخي العزيز تستبدل أول سطر في الكود وهو : ActiveSheet.DisplayRightToLeft = True بأن تضعه بين أمرين 1. إختيار كل الشيتات ثم 2. فصلها كالتالي Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select Sheets("Sheet1").Activate ActiveSheet.DisplayRightToLeft = True Sheets("Sheet1").Select وكذلك الحال لأوامر البوردر تضعها بين الأمرين بنفس الطريقة

السلام عليكم لتقليل الحجم لمجموعة من الصور بدرجة كبيرة جدا أولا: إذا كانت الصور خارج الإكسل 1. ضع (نسخة) من الصور المراد تقليل حجمها في مجلد جديد 2. إعمل كليك يمين علي أي صورة في المجلد الجديد إختر Open With 3. باستخدام برنامج لتعديل الصور وليكن Microsof Office Picture Manager الموجود علي معظم الأجهزة 4. إتبع الخطوات في الصورة المرفقة بالترتيب من 1 إلي 6 (في المثال بالصورة تم تقليل من 7 ميجا إلي 21 كيلو!!) ثانيا: إذا كانت الصور محملة علي ملف الإكسل 1. إعمل كليك يمين علي أي صورة في الملف 2. ثم إتبع الخطوات في الصورة الثانية