محمد طاهر عرفه

جزاك الله خيرا اخي M.hindawi علي التعديل و يسعدني جدا التعديل فى ما أضفت خصوصا ان كان للافضل كما حدث هنا :( فسبب تواجدنا معا فى المنتدي ان نستفيد من معرفة بعضنا و ان نكمل جميعا في اضافة ما نعرفه حتي نستفيد جميعا بالاضافة الي صاحب السؤال :d و أيضا التعميم الذي اضفته عملي جدا فالان هو لا يحتاج للاشارة الي الدالة او ان يشغل ماكرو (y) ملاحظة بسيطة : في الروتين الفرعي الخاصي بحدث عند التغيير لخلايا الملف اعتقد انه يمكننا حذف سطر changesearch (a) و الاكتفاء ب Target = changesearch(a) مباشرة كما فى الملف المرفق ام تري له ضرورة معينة ؟ أخي أحمد سعيد فقط اكتب فى أي مكان فى الملف و سيتم التعديل مباشرة فى ملف الاخ M.hindawi و هذا سيفيدك عند كتابة اي اسم جديد و يمكنك نقل الوحدات النمطية الي ملف بياناتك فى نفس اماكنها لاستخدامها فى ملف آخر فالدالة الرئيسية مكتوبة فى موديول و الاستدعاء العام للتنفيذ مكتوب فى مكان كتابة الموديول الخاص بالملف و لتنفيذ ذلك افتح ملفك مع الملف الحالي اضغط ALT + F11 سيظهر محرر الكود و به الملفان المفتوحان اختر الموديول الموجود فى الملف و اسحبه الي ملفك انقر علي workbook فى ملف Hamza ستجد كود قم بنسخه ثم انقر مرتين علي كلمة workbook في ملفك ثم قم بلصق نفس الكود و بذلك يكون ملفك مجهزا لاستبدال اي اسم تكتبه اليا و اعتقد انك قد تريد انك تريد تغيير بعض الاسماء الموجودة فى ملفك اصلا و التي لن تتأثر بما سبق الا عند اعادة كتابتها او تحريرها لذا ستجد فى الملف المرفق هنا الخيار الاخر و هو ان تختار بعد الخلايا المكتوبة بالفعل علي ان يكون الاختيار من اعلي الي اسفل ثم تضغط ALT+F8 ليظهر لك الماكرو الجديد الذي بتشغيله يتم تغيير الخلايا المكتوبة بالفعل و ايضا يمكنك نسخ الماكرو الي اي ملف او هنا لانك فى الغالب ستسخدمه مرة واحدة فقط يمكنك فتح الملف المرفق مع اي ملف و سيعمل الماكرو باذن الله دون نقله شرط ان يكون المفان مفتوحان آنيا Sub changeletters() Dim a As String, rowcount As Integer rowcount = Selection.Rows.Count For i = 1 To rowcount a = Selection.Cells(i).Value Selection.Cells(i).Value = changesearch(a) Next i End Sub و الدالة كما سبق فى ملف الاخ هنداوي Public Function changesearch(Mytxt) As String Dim tempstr As String tempstr = Trim(Mytxt) If tempstr Like "*[أاآإ]*" Then For b = 1 To Len(tempstr) If Mid(tempstr, b, 1) = "ا" Or Mid(tempstr, b, 1) = "إ" Or Mid(tempstr, b, 1) = "أ" Or Mid(tempstr, b, 1) = "آ" Then Mid(tempstr, b, 1) = "ا" Else End If Next End If If tempstr Like "*[ةه]*" Then For b = 1 To Len(tempstr) If Mid(tempstr, b, 1) = "ة" Or Mid(tempstr, b, 1) = "ه" Then Mid(tempstr, b, 1) = "ه" Else End If Next End If If tempstr Like "*[ىي]*" Then For b = 1 To Len(tempstr) If Mid(tempstr, b, 1) = "ى" Or Mid(tempstr, b, 1) = "ي" Then Mid(tempstr, b, 1) = "ي" Else End If Next End If changesearch = tempstr End Function و التعميم لتفيذ الدالة علي اي خلية فى الملف عند كتابتها او تحريرها - اي تغيير محتوياتها Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim a As String a = Cells(Target.Row, Target.Column).Text Target = changesearch(a) End Sub مرفق الملف و به الاثنان التعميم عند تغير قيمة اي خلية و الماكرو لتعديل القيم الموجودة اصلا hamza2.zip

يا اخي راجع الجملة السابقة تاكد من تفعيل الماكرو ( مستوي الامان قبل فتح الملف ) لكي تعمل الدوال التي اعدها المستخدم User defined functions لابد من مراجعة مستوي الامان للماكرو و ذلك من Tools Macro security و اختار Medium ليعمل مباشرة او Medium ليخيرك و بعد ذلك افتح الملف و بالتالي ستعمل الدالة و بكتابة اسم فى العمود الاول سينتج الاسم الجديد فى العمود الثاني و يمكنك سحب المعادلة لاي عدد من الخلايا يعني هذه دالة تعمل مثل دالة sum مثلا و لكن لابد من السماح بعمل الماكرو كما سبق

الابسط اذا كنت تريد مجرد الا يظهر الصفر ان تتحكم فى الخاصية من قائمة tools options و الغي اختيار Zero values حل اخر طبعا يمكنك استخدام معادلة IF و يوجد عليها اكثر من مثال فى الارشيف و مرفق مثال مبسط لجمع ثلاثة خلايا صفراء اللون فى خلية صفراء اللون و لا يظهر المجموع اذا كان = صفر و صيغة المعادلة كالتالي =IF(SUM(D6:F6)<>0,SUM(D6:F6),"") sum.zip

انقر بالزر الايمن علي المربع و اختار تنسيق عنصر التحكم format control و من تبويب خصائص properties لا تختار مربع الطباعة ، فلا ينطبع و من تبويب تحكم control اختار الخلية المراد ربطها و تم التطبيق علي المربع الموجود فى الخلية D4 فى مثالك فقط و لكن هنا الناتج يظهر فى صورة True و false و ليس 1 و 0 و يمكنك التعامل معه لاحقا بمعادلة if مثلا checkbox.zip

مواضيع ذات صلة للاخ ابو هادي - فى الاكسيس : http://www.officena.net/Tips/Punctutation.php تفقيط عربي انجليزي محدث تعديل التفقيط إلى كلمة درجة تحياتي .

مواضيع ذات صلة للاخ ابو هادي فى الاكسيس : http://www.officena.net/Tips/Punctutation.php تفقيط عربي انجليزي محدث تعديل التفقيط إلى كلمة درجة

اذا ضغط علي الوصلة العلوية ستصل الي موضوع به مثال : اضغط هنا و بالنسبة للبحث عن الكلمة ، المقصود البحث من قائمة بحث اعلي المنتدي هنا و عموما تفقيط = Punctuation

السلام عليكم اترك للاخ وليد الحديث حول ملفه بعد المراجعة و لكن هنا فى هذا الموضوع http://www.officena.net/ib/index.php?showtopic=33&hl=تفقيط كنت قد عدلت احدي الدوال ايضا لتناسب عملة الكويت ( آخر دالة ) فى ملف الاكسيل فضلا عن ان افضل الامثلة و هو مثال الاخ ابو هادي فى الاكسيس يغطي كل الاحتمالات

راجع تفاصيل هذا الموضوع كبداية http://www.officena.net/ib/index.php?showtopic=2713 و المنتدي مليئ بالامثلة التي ستكون نوعا ما اوضح لك باذن الله بعد قراءة المواضيع السابقة ايضا هذه المواضيع فى قسم الاكسيس يمكن ان تكون مفيدة جدا حيث أن الاساسيات واحدة اكتب بنفسك روتين فرعي أو وظيفة http://www.officena.net/ib/index.php?showtopic=425&hl= حديث حول المتغيرات فى VB http://www.officena.net/ib/index.php?showtopic=839&hl=

من هنا http://www.officena.net/ib/index.php?showtopic=29&hl=قرش

يا هلا :( مرفق ملف عبارة عن كود فى الاكسيس للاخ ابو هاجر قمت بالتعديل عليه ليناسب الاكسيل و يتم فيه استبدال ال أ و ا و آ و إ ب ا و ال ة و ال ه ب ه و ال ي و ال ى ب ي تاكد من تفعيل الماكرو ( مستوي الامان قبل فتح الملف ) :pp: ملاحظة : تم تعديل الملف فى مشاركة لاحقة للاخ m.hindawi

Tools Options Mail Format Signature new

ما شاء الله مثال غاية فى الروعة مبدع كما عودتنا دائما (y)

اضغط end مع السهم الاسفل للوصول الي اخر خلية بها بيانات ثم السهم مرة أخري او Enter

السلام عليكم اخي ابو هادي لم يعمل الملف معي هل سنحدث البيانات فى صفحة events ثم نشغل الماكرو ؟

بفرض ان الكيلو فى العمود الاول و المتر فى التالي و السم فى الثالث Private Sub Worksheet_Change(ByVal Target As Range) Dim aval, bval, cval aval = Range("a" & Target.Row).Value bval = Range("b" & Target.Row).Value cval = Range("c" & Target.Row).Value If ActiveCell.Column = 1 Then If Target.Column = 1 Then Range("b" & Target.Row).Value = aval * 1000 Range("c" & Target.Row).Value = aval * 100000 Exit Sub End If End If If ActiveCell.Column = 2 Then If Target.Column = 2 Then Range("a" & Target.Row).Value = bval / 1000 Range("c" & Target.Row).Value = bval * 100 Exit Sub End If End If If ActiveCell.Column = 3 Then If Target.Column = 3 Then Range("b" & Target.Row).Value = cval / 100 Range("a" & Target.Row).Value = cval / 100000 Exit Sub End If End If End Sub ExcelUnits.zip

راجع هذا الموضوع فى الارشيف http://www.officena.net/ib/index.php?showtopic=2633

عليك بالجداول المحورية http://www.officena.net/ib/index.php?showtopic=150

http://www.officena.net/ib/index.php?showtopic=9485 او استخدم البحث فى الارشيف عن كلمة تفقيط و ستجد عدد من المواضيع و الامثلة باذن الله

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

يبدو لي ان هذا صعب تحقيقه و نجاحه و لكن جرب :h احد اهم العناصر التي لها تأثير فى الموضوع هو محرك الطابعة Driver و احيانا كثيرة يوجد توافق بين كثير من المحركات فيمكنك البحث عن محرك طابعة متوافقة او بلوتر و تكون تسمح بورق اكبر و الطباعة الي طابعتك من خلال المحرك الجديد - يعني تعمل تحميل للطابعة الكبيرة كانها موصلة الي جهازك و تجعلها الافتراضية ثم تنزع درج الطابعة و تحاول تثبيت الازرار الداخلية بحيث تفهم الطابعة ان الدرج فى مكانه ، او تدخل الورق المستمر من الجهة الخلفية كما فى بعض الطابعات او اذا كان فيه خيار Manual Feed فى الطابعة

موضوع مرتبط من هنـــا

فكرة جميلة (y) و هذا رابط لموضوع مشابه و لكن كان المطلوب التعامل معه بالكود http://www.officena.net/ib/index.php?showtopic=42

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

المثال password.zip