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

من قائمة Format Sheet Backgroung و اختار الصورة ستجدها فى الخلفية background.rar

هذا المثال يقوم بنقل القيمة فى a1 الي b1 عند الفتح و مع تشغيل الماكرو المسمي ihaveseenit يتم تنفيذ نفس العملية و هو مثال علي تنفيذ عملية عند كل فتح للملف Private Sub Workbook_Open() x = ActiveWorkbook.Worksheets(1).Range("a1").Value 'MsgBox x ActiveWorkbook.Worksheets(1).Range("b1").Value = x End Sub Sub ihaveseenit() x = ActiveWorkbook.Worksheets(1).Range("a1").Value ActiveWorkbook.Worksheets(1).Range("b1").Value = x End Sub Autoupdatechange.zip

هذا المثال لاختبار التاريخ و تحديد هل يقع فى الاسبوع الحالي أم لا ؟ بطريقتين الاولي بالداوال علي أكثر من خطوة و الثانية بالكود Function THISWEEK(MYDATE) As Boolean If IsNull(MYDATE) Then THISWEEK = FLASE Exit Function End If Dim checkday As Byte, startdate As Date, enddate As Date checkday = Weekday(MYDATE, 1) If checkday = 7 Then checkday = 0 startdate = MYDATE - checkday enddate = startdate + 6 'MsgBox startdate 'MsgBox ENDDATE If ((startdate <= Now()) And (enddate >= Now())) Then THISWEEK = True Else THISWEEK = False End If End Function Function Myweekday(MYDATE As Date) Dim checkday As Byte checkday = Weekday(MYDATE, 1) If checkday = 7 Then checkday = 0 Myweekday = checkday End Function checkthisweek.zip

هذا الكود يقوم بملء الخلايا الخالية فى العمود المختار ، بنفس القيمة الموجودة فى اول خلية ، الي أن يصل الي خلية بها قيمة ، فيقوم باستخدام القيمة الجديدة وهو مفيد فى الحالة التالية مثلا ان العمود الاول مكتوب به البلد مرة واحدة ، و امامها عدة اسطر للموظفين ثم البلد التالية بعد عدة أسطر و هكذا و تريد فى قائمة طويلة مليء البلد امام كل موظف ، فما عليك الا التعليم علي اخلايا فى العمود المطلوب ملؤه ثم تشغل الماكرو التالي : ( راجع المثال لتكون الصورة أوضح ) :) Sub FillEmptyAsAbove() ' ' deleteemptyRow Macro ' Macro recorded 19/07/2000 by taher to delete empty rows in aselection Application.ScreenUpdating = False Dim MyRow As Long, origraw As Long ' Z As String MyRow = Selection.Rows.Count origraw = MyRow ActiveCell.Select 'MsgBox MyRow For i = 1 To MyRow - 1 'If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Activate If ActiveCell.Offset(i, 0).Value = "" Then 'ActiveCell.EntireRow.Delete 'MyRow = MyRow - 1 ActiveCell.Offset(i, 0).Value = ActiveCell.Offset(i - 1, 0).Value End If Application.StatusBar = "Parsing / deleting ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub Fill_all_empty.zip

هذا الكود يقوم باخفاء الاسطر التي لا توجد بها أي قيم فى العمود B و يعتمد علي تسمية مجال محدد يسمي Myrange لتحديد عدد الصفوف المطلوب ادراء هذه العملية عليها Sub hidemptyRow_basedonthiscol() ' ' hideemptyRow Macro ' Macro recorded 25-12-02 by taher to hide empty rows in aselection Application.ScreenUpdating = False Application.Goto Reference:="myrange" Myrows = Selection.Rows.Count origraw = Myrows ActiveCell.Select For i = 1 To Myrows - 1 If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = "" Then ActiveCell.EntireRow.Hidden = -1 ActiveCell.Offset(1, 0).Activate Myrows = Myrows - 1 End If Application.StatusBar = " checking ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub[/sql] HideEmptyRows.zip

نفس المثال بالطريقة التقليدية لاضافة سنة =+DATE(YEAR(A1)+1;MONTH(A1);DAY(A1)) لاضافة 3 أشهر =+DATE(YEAR(A1);MONTH(A1)+3;DAY(A1)) لاضافة 5 أيام =+DATE(YEAR(A1);MONTH(A1);DAY(A1)+5) او =+A1+5 add_date2.zip

مثال آخر لحساب العمر بعدة طرق منها كود للأخ أبو هاجر agecalc.zip

مثال علي استخدام الدالة IF اذا كان التاريخ أكبر من قيمة محددة ، نحسب الغرامة بقيمة 50 جنيه ، و اذا لم يكن تكون 10% من المبلغ المستحق و طبيعة الدالة أنها تنقسم الي 3 أجزاء بينما فاصلو منقوطة ; الاول يعبر عن الشرط : اذا كان التاريخ أكبر من قيمة محددة الثاني القيمة الناتجة من الدالة فى حالة تحقق الشرط : 50 الثالث : القيمة الناتجة من الدالة فى حالة عدم تحقق الشرط : 10% من المبلغ =+IF(C4>=DATE(2003;1;1);50;A4*0.01) IFDATE2.zip

مثال آخر علي دالة لتحديد المجموعة بناء علي الرقم ثم تحليل النتائج باستخدام الجداول المحورية gradegroups.zip

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

دالة لاضافة شهور و سنين باستخدام DateAdd حيث لا يمكن استخدامها مباشرة فى ورقة العمل Function addmonth(mydate As Date, no As Integer) As Date addmonth = DateAdd("m", no, mydate) End Function Function addday(mydate As Date, no As Integer) As Date addday = DateAdd("d", no, mydate) End Function Function addyear(mydate As Date, no As Integer) As Date addyear = DateAdd("yyyy", no, mydate) End Function add_date.zip

Function refverseText(mycell) Dim mcount As Long, mtxt As String mcount = Len(mycell.Value) mtxt = mycell.Value Dim m As String For i = mcount To 1 Step -1 m = m & Mid(mtxt, i, 1) Next i refverseText = m End Function reversetext.zip

السناريو هو احد أدوات ال what-if analysis و هذه العبارة تعني باختصار تغيير بعض القيم لنري نتائجها علي المعادلات الموجودة فى ورقة العمل بمعني أنه لو هناك ثلاث سيناريوهات للبيع و الدخل مثلا كل منها له قيم مختلفة و بناء علي هذه القيم توجد معادلات أخري كثيرة و تود رؤية تأثير التغيير بين السيناريوهات الثلاثة علي النتيجة ، و بالطبع لا تريد أن تكتب القيم كلما أردت رؤية تأثيرها فاذهب الي قائمة tools scenarios add و حدد اسم السيناريو و حدد مجال ادخال القيم و ليكن E4:E5 كما فى المثال المرفق و هي الخلايا باللون الاصفر فى المثال و سيسألك عن القيم المراد تذكرها ، فاكتبها و أضف السيناريو الثاني و الثالث بنفس الأسلوب مع تغيير القيم والآن لتري تأثير السيناريوهات المختلفة علي النتائج Tools scenarios show و ستظهر قائمة السيناريوهات و كلما إخترت أحدها سيظهر تأثيره بالاضافة الي ذلك لتحصل علي مقارنة بين الثلاث سيناريوهات إختار زر summary و سيظهر لك خياران الاول يظهر مقارنة النتائج كما فى ورقة العمل المسماة Scenario Summary و هو سيستنتج خلية المنتيجة التي تريد مقارنتها ، و يمكنك تغييرها قبل التنفيذ و الثاني يظهر المقارنة فى جدول النتائج المحوري كما فى ورقة العمل المسماة Scenario PivotTable مع تحياتي scenarios.zip

هذا مثال لاستنتاج اسم الوردية بناء علي توقيت البدء باستخدام SELECT CASE Function getshift(mycell) Dim x As Double x = Round(mycell.Value, 1) Select Case x Case 7 To 15.5 getshift = "صباحية" Case 15.51 To 24 getshift = "وسطــي" Case 0 To 6.5 getshift = "مسائية" Case Is > 24 getshift = "توقيت خاطيء" End Select End Function shifts.zip

أحيانا تحتاج الي إظهار القيمة المناظرة لمعادلة مكتوبة بصورة نص لاستخدامها فى التوضيح ، مثلا (100-40)/2 و اذا أدرت إظهار المعادلات المكتوبة فهذا يظهر للشيت كله و ليس لبعض الخلايا فقط أما اذا أردت فقط اظهار بعض المعادلات علي هيئة نص مكتوب ، فلابد من أن تكون بتنسيق نص و لكن هذا لا يعني عدم استخدامها فى الحسابات :d المعادلة المكتوبة علي صورة نص فى الخلايا الصفراء مثل (100-40)/2 إختار الخلايا الخضراء ثم نفذ الماكرو ليسألك عن القيمة التي تود ضربها فيه او اضافتها اليها ا ثم يجري العملية و الكودان ، الاول للضرب و الثاني للجمع ( علي القيم المكتوبة كمعادلات نصية ) فاذا أردتها كما هي فاضرب فى 1 أو اجمع صفر ، و الخلية التي ستنتج يمكن استخدامها فى اي حسابات بعد ذلك Sub MakeValmultiply() Dim x As Double x = InputBox("select the Value to multiply", "Value to be multiplied to Text Formulas", 1) Dim myrow As Integer myrow = Selection.Rows.Count For i = 1 To myrow ActiveCell.Formula = "+" & ActiveCell.Offset(0, -1).Value & "*" & x ActiveCell.Offset(1, 0).Activate Next For i = 1 To myrow SendKeys "{f2}{Enter}" ActiveCell.Offset(-1, 0).Activate Next End Sub Sub MakeValadd() Dim x As Double x = InputBox("select the Value to add", "Value to be Added to Text Formulas", 1) Dim myrow As Integer myrow = Selection.Rows.Count For i = 1 To myrow ActiveCell.Formula = "+" & ActiveCell.Offset(0, -1).Value & "+" & x ActiveCell.Offset(1, 0).Activate Next For i = 1 To myrow SendKeys "{f2}{Enter}" ActiveCell.Offset(-1, 0).Activate Next End Sub ShowtxtFormulaValue.zip

مثال علي الجمع و الجمع الشرطي و جمع المضروب ٍsum sumif sumproduct sumIF.zip

فى المثال المرفق ثلاث طرق للتحكم فى البيانات المدخلة الأولي بالكود و هنا يتم التحقق من أن البيانات المدخلة فى الخلية d2 لابد أن تبدأ ب FGK Private Sub Worksheet_Change(ByVal Target As Range) If UCase(Left(Range("d2").Value, 3)) <> "FGK" Then MsgBox "Not Accepted Entry, should start with FGK" Range("d2").Value = "FGK" Exit Sub End If End Sub و الثانية عن طريق معادلة if الشرطية و اظهار النتيجة فى الخلية المجاورة و الثالثة عن طريق أمر Validation من قائمة data و عليه يوجد 3 امثلة الاول للتحكم بان الرقم بين 10 و 100 و الثاني لأن النص لا يزيد عن 5 حروف و الاخير لان الرقم أقل من 1000 و فى الاخير تم استخدام خاصية الرسالة التي تظهر عند الوقوف فى الخلية و تغيير رسالة الخطأ و ذلك ايضا من امر validation من قائمة data Validation.zip

إختلاف التنسيق لأحد أيام الاسبوع و ليكن الجمعة مثلا ( بناء علي التاريخ ) و ذلك بوضع شرط التنسيق Formula is : =WEEKDAY(D5;1)=6 weekdayconditional.zip

Format Borders and Shading Page Border Option Measure from Text أو حل آخر بقم يتصغير مقاس الورقة من اعدادات الصفحة

هذا كود لعمل احصائية لانواع الحروف المختلفة Dim LetterMat(2, 256) As Variant Sub Countaletter() For i = 32 To 255 LetterMat(2, i) = 0 Next For i = 32 To 255 LetterMat(1, i) = Chr(i) Next 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......." For j = 32 To 255 If .Text = LetterMat(1, j) Then LetterMat(2, j) = _ LetterMat(2, j) + 1 Next End With Next i Dim m As String For j = 32 To 64 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m m = "" For j = 65 To 90 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m m = "" For j = 91 To 122 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m m = "" For j = 123 To 192 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m m = "" For j = 192 To 255 m = m + (LetterMat(1, j)) + ":" + _ Str(LetterMat(2, j)) + " " ' + Chr(13) If j Mod 3 = 0 Then m = m + Chr(13) Next MsgBox m End Sub CountallLetternew.zip

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 = "&Atilde;" Or Mychr = "&Aring;" Or Mychr = "&Acirc;" Then Mychr = "&Ccedil;" End If If Mychr = "&iacute;" Or Mychr = "&igrave;" Then Mychr = "&igrave;" 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 ثم بعد ظهور نظم ادارة قواعد البيانات أصبحت هذه العملية تتم من خلال واجهة رسومية سهلة الاستخدام قادرة علي انشاء و التحكم أيضا فى قواعد البيانات و هذه اللغة مسئولة عن : إنشاء جدول الغاء جدول تعديل جدول العلاقات و للتعامل معها من خلال الاستعلامات لا يوجد سوي استعلام انشاء جدول جديد أما الباقي فعلينا بالتعامل معهم بالكود لغة التحكم تتولي معالجة صلاحيات المستخدمين و هذه العمليات أيضا أصبحت تتم من خلال الواجهة الرسومية لنظم ادارة قواعد البيانات موضوع مرتبط : أسهل طريقة لكتابة جمل سي كيو ال بالكود