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

VBA ماكرو يقوم بعد عدد الحروف من حرف معين فى وورد مع الأخذ بالاعتبار أن ال أ =ا=آ Public MyLetter As String Sub Countaletter() MyLetter = InputBox("Enter the Letter", "Delete Except that letter", "M") If Len(MyLetter) > 1 Then MsgBox "Write One Chr Please !", vbExclamation, "One Chr is only Allowed" Exit Sub End If MyLetter = Searchit(MyLetter) Application.ScreenUpdating = True Mycounter = 0 Selection.WholeStory Mcount = Selection.Characters.Count ' MsgBox mcount For I = 1 To Mcount With Selection.Characters(I) Application.StatusBar = "Searching ...." & _ I & "/" & Mcount & " Please Wait......." If Searchit(.Text) = MyLetter Then Mycounter = Mycounter + 1 End If End With Next I MsgBox Str(Mycounter) + " Matches of Letter " + MyLetter End Sub Function Searchit(Mychr) If Mychr = "Ã" Or Mychr = "Å" Or Mychr = "Â" Then Mychr = "Ç" End If If Mychr = "í" Or Mychr = "ì" Then Mychr = "ì" End If Searchit = Mychr End Function CountLetter.zip

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

مثال لحساب الفرق بين تاريخين ، أو بين تاريخ و تاريخ اليوم باليوم و الشهر و السنة بالاضافة الي إجمالي عدد الأشهر ملاحظة :تم تعديل المثال بعد تحميله لعدة مرات يوجد مثال آخر فى المشاركة التالية فى نفس هذا الموضوع بثلاث طرق مختلفة : DATE.rar

كثير ما نحتاج لكتابة جمل SQL داخل كود فيجوال بيزيك التطبيقات و ذلك اما لتنفيذ استعلامات مركبة أو لبناء منطق معين داخل جملة الاستعلام نفسه و لكن هل تحتاج لكتابة جملة السي كيو ال مباشرة ؟؟ الاجابة لا كل ما عليك هو تنفيذ استعلام يناظر أو يشابه شكلا ما تريد ، ثم عرض الاستعلام فى واجهة ال سي كيو ال و نسخ الكود ثم التعديل فيه مثال للتوضيح أكثر اذا أردت تنفيذ استعلام إضافة يضيف القيم الموجودة فى حقلين فى جدول رقم 2 الي جدول رقم واحد يمكن اعداد الاستعلام بالطريقة العادية و اذا نظرنا الي عرض ال SQL له يكون كالتالي INSERT INTO Table1 ( Field1, Field2 ) SELECT Table2.Field1, Table2.Field2 FROM Table2; اما اذا أردنا تنفيذه بجملة SQL بال vba فكل ما علينا هو توحيد جملة ال SQL فى سطر واحد ووضعها بين "" علامتي تنصيص و أن نسبقها ب Docmd.RunSQL فتصير كالتالي : DoCmd.RunSQL "INSERT INTO Table1 ( Field1, Field2 )SELECT Table2.Field1, Table2.Field2 FROM Table2;" او لفصلها الي سطرين Private Sub Command0_Click() DoCmd.RunSQL "INSERT INTO Table1 ( Field1, Field2 )SELECT " & _ "Table2.Field1, Table2.Field2 FROM Table2;" End Sub و النتيجة واحدة و ما نستفيده هو امكانية التدخل فى بناء جملة ال SQL عن طريق منطق البرمجة

إستكمالا لكلام الأخ أمير تعالو أولا ، نتعرف علي لغة السي كيو ال السي كيو ال هو لغة التعامل مع قاعدة البيانات و ينقسم الي 3 أقسام لغة معالجة البيانات DML Data manipulation language لغة تعريف البيانات DDL Data Definition language لغة التحكم فى البيانات DCL Data Control language لغة معالجة الييانات ادراج بيانات تحديث بيانات حذف بيانات استرجاع بيانات لغة تعريف البيانات هي إنشاء قاعدة البيانات فى البداية كان يتم انشاء قاعدة البيانات باستخدام جمل SQL ثم بعد ظهور نظم ادارة قواعد البيانات أصبحت هذه العملية تتم من خلال واجهة رسومية سهلة الاستخدام قادرة علي انشاء و التحكم أيضا فى قواعد البيانات و هذه اللغة مسئولة عن : إنشاء جدول الغاء جدول تعديل جدول العلاقات و للتعامل معها من خلال الاستعلامات لا يوجد سوي استعلام انشاء جدول جديد أما الباقي فعلينا بالتعامل معهم بالكود لغة التحكم تتولي معالجة صلاحيات المستخدمين و هذه العمليات أيضا أصبحت تتم من خلال الواجهة الرسومية لنظم ادارة قواعد البيانات موضوع مرتبط : أسهل طريقة لكتابة جمل سي كيو ال بالكود

الحل هو هو جعل الاماكن المطلوب الكتابة فيها عبارة عن مربعات نص و بالتالي لا تخضع لحماية عند اختيار Tools Protect Documents Comments و لكن ليس مربعات النص العادية و لكن تلك التي توضع فى وضع تصميم الفيجوال بيزيك اختار اظهار مجموعة ايقونات الفيجوال من Toolbars Customize بالنقر علي شريط الأدوات ثم اختيار وضع التصميم بالضغط علي المربع الازرق ثم اختيار ال ToolBox و ووضع مربع نص و كل ذلك طبعا و الملف غير محمي ثم نختار Tools Protect Documents Comments فيتم حماية كل الملف ما عدا مربعات النص التي تم وضعها

تنسيق مفيد و خاصة للمحاسبين و التنسيق الذي وضعه الأخ شرف كالتالي : لمن لا يريد تنزيل الملف ### ### ### ##0.00;[Red](### ### ### ##0.00)

طريقتان الأولي : يتم ذلك بادراج section جديد و تكون له خصائص صفحة منفصلة و يتم ذلك من Insert Break Section Break Type Next Page مثلا الثانية من إعداد صفحة.. اختر السان حجم الورق ثم اختر اتجاه الصفحة كما تريد زمن ينطبق على اختر من هذه النقطة و الطريقة بالنسخة الانجليزية Page Setup Orientation : Landscape or Portrait Apply to : this Point Forward و هي طريقة أخري تؤدي أيضا لتكوين Section جديد

هذا الكود كتبته بناء علي طلب من أحد الأخوة ، كان يريد إستبدال المسافات فى ملف وورد بسطر جديد أي يريد توزيع الكلمات كل فى سطر جديد Sub replaceit() spacecount = 0 Selection.WholeStory scount = Selection.Characters.Count For i = 1 To scount If Selection.Characters(i).Text = " " Then spacecount = spacecount + 1 Next For i = 1 To spacecount Application.StatusBar = "Searching ...." & _ i & "/" & Mcount & " Please Wait......." With Selection.Find .Text = " " .Replacement.Text = "" End With 'If Selection.Find.Found = False Then Exit Sub Selection.Find.Execute Selection.TypeParagraph Next i End Sub replacespacewithenter.zip

أحيانا عند الاستيراد من خارج الاكسيل تجد تنسيق الخلايا لا يريد أن يتغير و عليك أن تمر علي خلية خلية لعمل double click ( نقر مذدوج ) أو تضغط F2 داخل كلية خلية قبل أن تتمكن من تغيير التنسيق و قد لا يكون ذلك مناسبا و هذا كود للقيام بتغيير تنسيق الخلايا المختارة الي "dd/mm/yyyy" علي سبيل المثال Sub Reenter_Format() Dim MyRow As Double, Z As String MyRow = Selection.Rows.Count For j = 1 To MyRow ActiveCell.Cells.NumberFormat = "dd/mm/yyyy" Z = ActiveCell.Value ActiveCell.Cells.FormulaR1C1 = Z ActiveCell.Offset(1, 0).Activate Next j End Sub Re_enterValues.zip

مع ملاحظة أن السطرين myrows = 20 mycols = 5 لتحديد مجال البحث ، و اذا اردت البحث بدءا من الخلية الفعالية الي آخر الشيت فأزل السطران Sub FindFirstEmpty() ' ' Application.ScreenUpdating = False Cells.Select myrows = Selection.Rows.Count mycols = Selection.Columns.Count myrows = 20 mycols = 5 origraw = myrows ActiveCell.Select For i = 0 To myrows - 1 For j = 0 To mycols - 1 If ActiveCell.Offset(i, j).FormulaR1C1 <> "" Then GoTo newrow End If Next MsgBox "Founf the Fist Empty Row " ActiveCell.Offset(i, j).Activate ActiveCell.EntireRow.Select Exit Sub ' ActiveCell.Offset(1, 0).Activate ' myrows = myrows - 1 newrow: Application.StatusBar = " checking ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub FindFirstEmpty.zip

مثال 2 : استخدام AND , OR =+IF(AND(A1>10;A3>10);1000;2000) =+IF(OR(A1>10;A3>10);1000;2000) فى الاولي اذا كانت القيمة فى كل من الخليتين a1,a3 أكبر من 10 فالناتج 1000 و ان لم يكن فالناتج 2000 فى الثانية اذا كانت القيمة فى أي من الخليتين a1,a3 أكبر من 10 فالناتج 1000 و ان لم يكن فالناتج 2000 ExcelIF2.zip

مثال اذا كتبنا رقم فى الخلية a1 يظهر فى الخلية B1 جملة تبين اذا كان الرقم أكبر أو أصغرمن 10 و ذلك بوضع المعادلة التالية فى الخلية b1 =+IF(A1>10;"bigger than 10";" Less than 10") و المعادلة تنقسم الي 3 أقسام -الشرط -القيمة فى حالة تحقق الشرط - القيمة فى حالة عد تحققه و اذا أردنا الناتج رقم مكان جملة =+IF(A3>10;1000;2000) أي أن النتيجة 1000 اذا تحقق شرط كون القيمة فى a3 اكبر من 10 و 2000 اذا لم يتحقق ExcelIF.zip

للحصول علي كل من الرقم العشري و الرقم الصحيح فى خانة مستقلة يمكن عمل ذلك بخطوتين 1- الحصول علي الرقم الصحيح =+INT(C5) 2- الحصول علي ناتج القسمة عليه =+MOD(C5;C6) او علي خطوة واحدة بدمج المعادلتين =+MOD(C5;+INT(C5)) Mod.zip

لا أعلم طريقة لعمل معادلة بالمعني المفهوم ، أي تحدث مع تغير القيم و اتعامل معها من خلال ادراج ورقة اكسيل داخل الوورد و طريقة حساب المعادلات فى الوورد ، لابد من تكرارها مع التحديث ، و ما يشجعني علي تصور عدم وجود حل آخر هو هذه الجملة فى التعليمات Note Microsoft Word table calculations must be manually recalculated. Consider using Microsoft Excel to perform complex calculations. و الطريقة كما يلي نختار الخلية المطلوب حساب المعادلة فيها نختار formula فيظهر مربع الحوار التالي ثم نعدل المعادلة ان أردنا باستخدام نفس طريقة تسميات الخلايا فى الاكسل أو كلمة Above لكل ما هم أعلي أو Right لكل ما هو يمين الخلية و تكون النتيجة كالتالي و لكن لا تتحدث الا بتكرار ما سبق

و هذا المثال للعكس Vlookup2.zip

فى هذا المثال يتم استخدام الدالة vlookup للحصول علي اسم البلد بناء علي رقمها من قائمة vlookup.zip

هذا مثال به مجموعة كبيرة من الدوال جمعتها من مشاركات الأخوة السابقة فى عدد من المواقع Punct_ALl.zip

مرفق مثال و هو يعتمد علي عمل اشارة مرجعية فى الخلية التي تسبق الرقم ثم التحرك منها الي الرقم و إضافة واحد عليه و لم يتم التحرك الي الرقم مباشرة لأن الاشارة المرجعية ستضيع فى هذه الحالة اذا تم تغيير القيمة Private Sub Document_Open() mm End Sub ----- Sub mm() Selection.GoTo What:=wdGoToBookmark, Name:="m1" Selection.MoveRight Unit:=wdCell Myval = Selection.Text Myval = CInt(Myval) + 1 Selection.TypeText Text:=Myval End Sub addoneOnOpen.rar

مثال به عدة طرق منها ما يعتمد علي دالة IF و ما يعتمد علي التنسيق الشرطي و منها الكود و هذا هو الجزء الخاص بالكود Private Sub Workbook_Open() If ActiveWorkbook.Worksheets(1).Range("d6").Value >= Now() Then MsgBox "the value in cell d6 is >= the current date !!" & Chr(13) & "BEST WISHES , FROM MOHAMED TAHER" End If End Sub و لرؤيته فى الملف اضغط ALT+F11 checkDate.zip

عندما نقوم بحماية ورقة العمل ، كيف يمكننا إستثناء بعض الخلايا من الحماية ؟؟ الإجابة : عن طريق استثناؤها من الحماية في الاكس بي Tools protection allow users to edit ranges ثم عرف المجال الذي تريد أو اختار الخلية و من القائمة المختصرة للماوس Format Cell و أزل خيار Locked ثم طبق الحماية علي ورقة العمل ستجد أن الخلية مستثناة من الحماية أي تقوم بعمل إستثناء للخلايا من الحماية عن طريق إختيارها ثم إختيار خصائص ، و حماية ، و الغاء تأمينها ثم عندما تطبق الحماية علي ورقة العمل ، تكون هذه الخلايا قد أستثنيت منها بالفعل

هذا مثال يوضح شيئين كيفية فصل القيمة بكسر الحنيه الي جنيه ، قرش ، مليم و كذلك لو كانت القيمة بالقرش ثم كيفية جمع الجنيهات و القروش و الملاليم فى الحالتين و طبعا المثال صالح للعملات الاخري مع التعديل ان لزم Mony.xls

السؤال : كيف يمكن تثبيت خلايا معينة فى المعادلة عند عمل سحب أو Drag ؟ الاجابة : علم علي الجزء المراد تثبيته في المعادلة و هو هنا a1 ثم اضغط علي f4 ستظهر علامتين $ قبل رقم الصف و العمود و معني ذلك ان الصف و العمود ثابتين عند النسخ أو السحب و بضغطة أخري و ضغطة ثالثة يتم تثبيت الصف فقط أو العمود فقط و ما يناسب الحالة قد يكون هو اما تثبيت الصف و العمود $a$1 أو تثبيت الصف فقط a$1 أو تثبيت العمود فقط $a1

يمكن عمل ذلك باختيار الشيت ثم طباعته و يكون الاختيار باسم الشيت كما فى الكود الاول أو رقمه كما فى الكود الثاني و هما لطباعة الثلاث شيتات فى الملف أما الكود الاخير فهو لطباعة جميع أوراق العمل مع ملاحظة أن يكون فى الورقة أي بيان قابل للطباعة ( ليست خالية ) Sub Print3Sheets() ActiveWorkbook.Worksheets("sheet1").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True ActiveWorkbook.Worksheets("sheet2").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True ActiveWorkbook.Worksheets("sheet3").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End Sub Sub Print3Sheets2() ActiveWorkbook.Worksheets(1).Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True ActiveWorkbook.Worksheets(2).Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True ActiveWorkbook.Worksheets(3).Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End Sub Sub PrintAllsheets() For i = 1 To ActiveWorkbook.Worksheets.Count ActiveWorkbook.Worksheets(i).Activate ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Next End Sub PrintSheets2.rar

يمكن التغيير عند فتح الملف بالكود التالي Private Sub document_Open() SendKeys "{f10}" SendKeys "tms" SendKeys "{tab}" SendKeys "l" SendKeys "{ENTER}" End Sub و هو لتغيير الحماية الي المستوي المتوسط ثم التحكم فى الخيارات عند الاغلاق ، بالكود التالي Private Sub Document_Close() Dim z As String X = MsgBox("DO YOU WANT TO MODIFY SECURITY LEVEL ??", vbYesNo, "check for security level") If X = vbNo Then Exit Sub zz: z = UCase(InputBox("Press M for Medium adn H for High")) If z = "M" Then SendKeys "{f10}" SendKeys "tms" SendKeys "{tab}" SendKeys "m" SendKeys "{ENTER}" Exit Sub ElseIf z = "H" Then SendKeys "{f10}" SendKeys "tms" SendKeys "{tab}" SendKeys "h" SendKeys "{ENTER}" Exit Sub Else GoTo zz End If End Sub secrityLevel.rar