VBA Code Library

7 ملفات

1. 

   تغيير لون و حجم و خط التشكيل فقط

   بواسطه محمد طاهر عرفه

   هذا الكود من أجل تغيير لون و حجم و خط التشكيل فقط
   لمجموعة خلايا
   و يمكن تغيير اللون و الحجم من الكود
   
   الفكرة أني اضطررت لاعداد لوحة بها أناشيد من أجل أطفالي ليضعوها فى الفصل
   و بعد كتابتها بالتشكيل ـ لم يعجبني أن التشكيل له نفس لون الكتابة
   و تغييره ممل جدا
   
   الكود يعمل على مجموعة الخلايا المختارة فقط
   فاختار الخلايا أولا ثم شغل الماكرو
   
   ملاحظة بالطبع لابد أن يسمح مستوى الأمان بتشغيل الماكرو
   Tools
   Macro
   Security
   Medium or Low
   
   آمل أن يكون مفيدا
   
   الموضوع الأصلي
   http://www.officena.net/ib/index.php?showtopic=1351
   

   496 تنزيل

   0 تعليقات

   تم التحديث مايو 30, 2010

2. 

   حل للتغلب على مشكلة تفعيل الماكرو فى اوفيس 2003

   بواسطه محمد طاهر عرفه

   أثناء اعداد الاصدار التالي من تطبيق توثيق الملفات الموجود فى المكتبة من هنا
   
   بحثت كثيرا عن حل للتغلب على مشكلة تفعيل الماكرو دون الجوء لموضوع شهادات اعتماد الماكرو
   حيث أنه فى النهاية حتى بعد إضافة شهادة الاعتماد ، لابد و ان يكون المصدر معرف بواسطة المستخدم لكي يعمل الكود فى حالة اختيار أعلي خيارات الأمان
   
   المهم الحل الذي أعجبني هو أن المستخدم عندما لا تكون الماكروهات مفعله لن يري البرنامج من الأساس ، و إنما سيري شاشة ترحيب تخبره بوجوب تفعيل الماكرو و إعادة تشغيل الملف
   كما فى الملف المرفق
   و أضفت ثلاثة طرق لتغيير مستوي الأمان
   - فتح الشاشة فقط و ترك الاختيار للمستخدم
   - تغيير المستوي عن طريق كتابة حرف L,M,H,V
   - تغيير الخيارات من نموذج
   
   و لكي تري الجزء الأول اجعل خيار الأمان High أو Very High ثم افتح الملف
   ستري الشاشة فقط
   ثم غير المستوي الي Low
   و افتح الملف لترى الأكواد الثلاثة
   
   جدير بالذكر أن الأكواد تعمدعلى مفهوم ال Send Keys لذا ستتغير بتغيير الاصدار
   أيضا تعلمت أن هذا المفهوم من أغلس المفاهيم ، حيث أن وجود أوامر أخري مثل msgbox مثلا و ان كانت بالكامل قبل أو بعد انتهاء جزئية الكود تجعله لا يعمل بدون سبب مفهوم حتى مع محاولات نقل التفعيل لمكونات أخري ، و لمن أراد بحث الموضوع جرب تفعيل الأجزاء الموجودة فى الكودباللون الأخضر
   
   أترككم مع الملف
   

   863 تنزيل

   4 تعليقات

   تم التحديث سبتمبر 16, 2009

3. 

   دالة تحويل التاريخ بين اليونيكس و الاكسيل

   بواسطه محمد طاهر عرفه

   احتجت لتحويل بعض البيانات المستخرجة من قاعدة بيانات من نوع MySQL يتم تخزين البيانات فيها بنظام اليونيكس بحسب نظام تشغيل السيرفر
   لتصبح مقروؤة فى الاكسيل
   فبحثت ووجدت هذه الدالة ، و ووصلة المصدر وضعتها فى الكود
   
   و أعددت هذا المثال البسيط ليستفيد منه من يبحث عن هذه المعلومة مستقيلا
   و به دالتان للتجويل من و الي الاكسيل مع اليونيكس
   
   و الكود كما وجدته أيضا يحوي اضافة تحويل التوقيت من التقيت العالمي UTC الى توقيت استراليا
   UTC-10
   
   
   و يمكن تطبيق التحويل للتنسيق بين اليونيكس و الاكسيل مباشرة بمعادلة
   
   
   =(C3/86400)+25569 حيث أن الاكسيل يخزن الارقام المناظرة للتواريخ بدءا من تاريخ 1900-01-01 و اليونيكس بدءا من 1970-01-01 لذا فالفرق بينهما 25569 و 86400 هو عدد الثواني فى اليوم و للتحويل من اكسيل الي يونيكس =(D5-25569)*86400
   
   و فى كل الاحوال اذا اردنا تغيير التوقيت نضيف أو نطرح
   3600 لكل ساعة فى فرق التوقيت
   
   و المثال الذي أعددته يحوى على الدالة الاصلية و التي تحوي اضافة 10 ساعات للتوقيت ( و مصدر الدالة فى الكود)
   و تنفيذ نفس التحويل من خلال معادلة فى السطر الثانى
   و أخيرا معادلة للتحويل فقط بين الزمنيين دون أخذ فرق التوقيت فى الاعتبار
   

   244 تنزيل

   1 تعليق

   تم التحديث أكتوبر 28, 2011

4. دالة معرفة (MyLook) لجلب البيانات مثل (VLookUp)

   بواسطه عبدالله المجرب

   هذه الدالة تقوم بعمل الدالة VLookUp ولكن يمكن استعمالها لمن يريد اضافة دوال بإسمه في الملف الذي يعمل عليه
   الدالة VLookUp لها اربع متغيرات هي :
   1. lookup_value (قيمة البحث)
   2. table_array (جدول البيانات)
   3. col_index_num (رقم العمود)
   4. range_lookup (قيمة منطقية للتطابق في البحث صفر وواحد لاي نتيجة)
   
   
   الدالة المعرفة MyLook لها ثلاثة متغيرات هي
   1. LookVal (قيمة البحث)
   2. Rng (جدول البيانات)
   3. iCol (رقم العمود)
   
   * الغرض من الدالة انه يمكن تعديل اسمها كما تريد وتحصل على نتيجة مماثلة لنتيجة الدالة VLookUp
   
   
   Function MyLook(LookVal As Variant, Rng As Range, iCol) For r = 1 To Rng.Rows.Count If Rng.Cells(r, 1) = LookVal Then MyLook = Rng.Cells(r, iCol): Exit For Next End Function
   

   927 تنزيل

   14 تعليقات

   تمت الاضافه مايو 22, 2012

5. كود (دالة) لعد الخلايا الغير فارغة وتجاوز الخلايا ذات القيمة صفر او المرتبة بمعادلة بخلايا اخرى

   بواسطه عبدالله المجرب

   كود الدالة
   
   Function Cont_UnBlnk(MyRng As Range) For Each cl In MyRng If Not cl = Empty Then x = x + 1 Next Cont_UnBlnk = x End Function
   
   الوصف
   
   * تقوم الدالة COUNTA بعد الخلايا التي بها البيانات في مدى معين ولكنها ايضا تحسب الخلايا ذات القيمة صفر او المرتبطة بمعادلة بخلية اخرى
   
   * وهذه الدالة (Cont_UnBlnk) تتجاو الخلايا الصفرية او المرتبطة بمعادلات
   
   يرجى تجربة المرفق وإبداء الراي والملاحظات
   

   701 تنزيل

   14 تعليقات

   تمت الاضافه مايو 19, 2012

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

   بواسطه محمد طاهر عرفه

   هذا المثال يوضح طريقتين لاستخراج بيانات مختارة من ملف اكسيل الي ملف نص و فتحه لعرض البيانات
   و هنا فى المثال المرفق سنستخرج البيانات من الثلاثة خلاية الملونة باللون الاصفر و هي الخلايا
   B3,C3,D3
   و تم اضافة عدة اسطر كمقدمة توضح كيفية كتابة نص عام و ادراج اسم ملف المصدر ، قبل تسجيل بيانات الخلايا الثلاثة فى الملف النصي
   و لا تنسي تغيير مسار الملف فى الكود لما يناسب جهازك قبل التشغيل
   هنا فى الكود و المثال يتم انشاء الملف النصي فى المسار
   
   T:\ و قم بتعديله اولا لما يناسبك و المثال فى الملف المرفق الكود الاول باستخدام امر Print Sub PrinttoFile() a1 = Cells(3, 2) a2 = Cells(3, 3) a3 = Cells(3, 4) Dim Filename As String Filename = "T:\testfile.txt" Open Filename For Output As #1 Print #1, "*********** www.officena.net *****************" Print #1, "Example to Write Values from Cells into a text file" Print #1, "Source : " & ActiveWorkbook.FullName & " : " Print #1, "*********** www.officena.net *****************" Print #1, Print #1, "Here are the Values: " Print #1, Print #1, a1 Print #1, a2 Print #1, a3 Close #1 Dim x x = Shell("notepad.exe " & Filename, 1) End Sub الكود الثاني باستخدام طريقة WriteLine Sub WriteLine() Dim fs, S, A, Filename Filename = "T:\testfile.txt" Set fs = CreateObject("Scripting.FileSystemObject") Set A = fs.CreateTextFile(Filename, True) A.WriteLine "*********** www.officena.net *****************" A.WriteLine "Write 3 cells values into a File " A.WriteLine "Source : " & ActiveWorkbook.FullName & " : " A.WriteLine "*********** www.officena.net *****************" A.WriteLine A.WriteLine "Here are the Values: " A.WriteLine A.WriteLine Cells(3, 2) A.WriteLine Cells(3, 3) A.WriteLine Cells(3, 4) A.Close Dim x x = Shell("notepad.exe " & Filename, 1) End Sub
   

   1,063 تنزيل

   9 تعليقات

   تم التحديث أبريل 20, 2012

7. كود حذف المكرر والابقاء على قيمة واحدة فقط

   بواسطه عبدالله المجرب

   الكود يقوم بحذف المكرر من القيم والابقاء على قيمة واحدة فقط
   ويعمل على مدى مفتوح
   ولا يقوم بحذف الصف بالكامل وانما يقوم بالحذف بطريقة الازاحة الى اعلى
   
   
   Sub Abu_Ahmed_Del() LR = [A1000].End(xlUp).Row For i = LR To 1 Step -1 If Application.CountIf(Range("A1:A" & LR), Cells(i, 1)) > 1 Then Cells(i, 1).Delete Shift:=xlUp Next End Sub
   

   492 تنزيل

   1 تعليق

   تمت الاضافه أبريل 21, 2012