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

مثال ظريف لاستخدام الشرط فى الاكسيل ، و به أيضا بالاضافة الي الدالة IF الدالة & و التي تستخدم فى ضم محتويات خليتين فى خلية واحدة أو نصين فى نص واحد و بريد صاحب المثال الاصلي يظهر بعد التنفيذ ، و فقط قمت بتعريب المثال و فى البداية ظننته يعتمد علي الكود ، و اتضح أنه تطبيق يعتمد علي المعادلات فقط و القيم مخزنة فى خلايا مخفية WorkEthicEvaluation.zip

Reports("Catalog").Printer.LeftMargin = 1440 'Set left margin to 1 inch Reports("Catalog").Printer.Orientation = acPRORLandscape 'Set orientation to landscape Reports("Catalog").Printer.PaperSize = acPRPSLegal 'Set paper size to legal

الشرح التالي للأخ امير عاطف يمكن عمل ذلك عن طريق الاجراء او الوظيفه PrintOut ووظيفة هذا الاجراء انه يطبع كائن في قاعدة البيانات النشطه مثل جدول البيانات او الاستعلام او التقارير او النماذج او الوحدات النمطيه وصيغة هذا الاجراء :- DoCmd.PrintOut printrange,pagefrom,pageto,printquality,copies,collate Printrange: وهي نطاق الطباعه قد يكون الكائن بالكامل او جزء محدد منه او نطاق الصفحات وتأخذ احدى القيم التاليه ... acpages-acprintall-acselection Pagefrom: وهي رقم الصفحه التي سوف تبدأ الطباعه منها Pageto: وهي رقم الصفحه التي سوف تنتهي عندها الطباعه Printquality: وهي نوعية الطباعه وتأخذ احدى القيم التاليه : Acdraft-achigh-aclow-acmedium Copies: وهي عدد النسخ المطلوب طباعتها Collate: وهو لترتيب النسخ المطبوعه ويأخذ احدى القيمتين Yes لترتيب النسخ No لعدم ترتيب النسخ المطبوعه ملاحظه: يجب بالطبع قبل هذا الاجراء مباشرةً ان نضع الاجراء الخاص بفتح التقرير المراد طباعته

السؤال : أريد أن أجعل لصفحة التقرير الأولى هوامش والصفحة ثانية هوامش تختلف عن الصفحة الأولى وخاصة الهامش العلوي0 الإجابة للأخ أبو هاجر تغيير هوامش الصفحة يتم عن طريق خاصية اسمها Prtmip لكن هذه الخاصية يمكن القراءة منها والكتابة في وضع التصميم فقط أما في وضع التنفيذ فهي للقراءة فقط هذا بالطبع لا يعني أنك لا تستطيع فعل ما تريد بل دائماً تستطيع العثور على حلول بديلة مثلاً التحكم في مقطع رأس الصفحة بحيث تجعله 5 سم في الصفحة الأولى و 8 سم في الصفحة الثانية وهكذا الكود التالي مثال لذلك Dim PMarginPages As String PMarginPages = "-1-2-" ' اكتب أي صفحات تريد أن تطبق عليها أمراً ما مع وضع أرقام الصفحات بين شرطتين مثل -1- If InStr(1, PMarginPages, CStr(Me.Page)) > 0 Then ' اكتب هنا الأوامر التي تريد تنفيذها على هذه الصفحة فقط ' مثل عرض رسالة معينة MsgBox "صفحة ذات إعداد خاص" Me.Section(3).Height = 10000 وثمة طريقة أخرى وهي من خلال التحكم في رأس التقرير بحيث يكون 8 سم ورأس الصفحة بحيث يكون 5 سم واختيار خاصية عدم عرض رأس الصفحة مع رأس التقرير

السؤال : اريد أن يطبع رقم صفحة التقرير ادا كان التقرير يحتوي على أكثر من صفحة وأن لا يطبع أي رقم اذا كان التقرير يحتوي على صفحة واحدة فقط هل من الممكن عمل ذلك لأنه في حالة وضع الترقيم على صفحة واحده يكون شكل التقرير غير مقبول . الاجابة للأخ حارث : في مربع النص الذي يعرض أرقام الصفحات اكتب في مصدر عنصر التحكم فيه : =IIf([Pages]>1;"صفحة " & [Page] & " من " & [Pages])

كود للأخ فيصل الحربي : :d لقياس سرعة فتح التقارير ضع الكود التالي في حدث عند الفتح للتقرير ويجب عليك تغيير اسم التقرير بدلا من YourReportName dim dtStart as date dim dtStop as date dtStart = Now() docmd.openreport "YourReportName" dtStop = Now() msgbox "Time to open: " & dtStop-dtStart

هناك عدة حلول لهذه المشكلة ، و التي ظهرت فى الاوفيس اكس بي و قد عرض لها الكثيرين أكثر من حل : الاول : ان تستغني عن وضع العنوان فى راس الصفحة بوضعه فى راس مجموعة تجميع معينه و تجعل خاصية التكرار لراس هذه المجموعة مفعلة الثاني: ممل قليلا و هو وضع حقل مستنتج فى الاستعلام المبني عليه التقرير قيمته ثابتة و عمل تجميع به و جعل خاصية التكرار لراس المجموعة الخاصة به مفعلة الثالث : من خصائص التقرير أختر تنسيق ثم إتجاه ثم من اليمين الى اليسار حولها الى من اليسار لليمين الرابع : من عرض تصميم التقرير اختيار أمر إعداد الصفحة من قائمة ملف اختيار الامر الثالث (أعمدة) ومنه ازالة علامة صح من امام (مماثل للتفصيل) ومن ثم زيادة عرض التقرير التقرير قليلا

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 الموضوع فى الاكسيل ، مع مثال

سيتم افتتاح المنتدي لمشاركات الأعضاء فى 1/7/2003 بإذن الله تعالي و نسأل الله أن يجعله فى ميزان حسنات كل من شارك و سيشارك فى نشر العلم من خلال هذا المنتدي.

بإذن الله تعالي ستبدأ أولي دورات الموقع (( الأكسس من البداية حتي الاحتراف )) فى 5/7/2003 أي بعد الافتتاح بخمسة أيام بإذن الله و نسأل الله أن تتوالي الدورات بعدها و قد اكتمل العدد المطلوب للتسجيل فى هذه الدورة ، و نسأل الله سبحانه و تعالي أن تكون دورة ناجحة و مفيدة و أرجو ممن يطلب التسجيل بعد الاغلاق الانتظار للدورة القادمة بإذن الله تعالي

السلام عليكم أخي امير ما هي وصلة البرنامج الذي حجمه 600 ميجا ؟؟ بالنسبة للروابط أعتقد أنها تم تعديلها : الروابط : 1 2

السلام عليكم تم تعديل الملف 1- تم ربط التواريخ بتاريخ اليوم 2- تم اضافة الكود التالي : لتحديث نتيجة الدوال عند فتح الملف ووجود تعديل فى تاريخ الجهاز Private Sub Workbook_Open() Me.RefreshAll End Sub

المثال الثاني DefaultCellVal2.zip

لكتابة الكود بطريقة أخري فى الجزء الخاص بأكواد ورقة العمل و هنا يتم التحكم فى خلية فى الشيت الاول ملاحظة : لا ستخدام me مع workbook يجب تعريف الشيت Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) With Me.Sheets("sheet1").Range("a1") If .Value = "" Then .Value = "Officena" End If End With End Sub و للتعامل مع الشيت و ليس مجلد العمل - من مشاركة للأخ امير فى موضوع آخر بتصرف و هنا يتم التعامل مع الشيت الثاني ، و يتم كتابة الكود فى الجزء الخاص باكواد الشيت الثاني Private Sub Worksheet_Change(ByVal Target As Range) With Me.Range("a1") If .Value = "" Then .Value = "Officena" End If End With End Sub

اذا كانت الخلية خالية فسيتم تغيير القيمة الي أوفيسنا و اذا كان بها قيمة لن يحدث شيء عند التغيير Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Range("a1").Value = "" Then Range("a1").Value = "Officena" End If End Sub DefaultCellVal.zip

عندما تغلق ملف الاكسيل ، فعند فتحه ثانية يفتح علي آخر ورقة عمل فاعلة فاذا كنت تريد ان تجبره علي الفتح علي ورقة عمل محددة : Private Sub Workbook_Open() Sheets("sheet2").Activate End Sub OpenOnSheet.zip

نعم مع اعتبار أن المسافة متغيرة بحسب نوع الطابعة

النسخة ذات واجهة التطبيق العربية ، تنتشر فى بعض البلدان العربية، أما النسخة ذات الواجهة الانجليزية فهي تنتشر فى بعض البلدان الأخري و عن نفسي أفضل النسخة الانجليزية ،و هذا نابع من الاختلاف فى نشر تطبيقات الاكسس المعدة عليها تحديدا ،فهي و تصلح للعمل علي الأجهزة التي محمل عليها مختلف انواع الويندوز سواء المعربة أم لا أما النسخة ذات واجهة التطبيق العربية ، فلا تعمل ملفات الاكسس التي يتم تصميمها عليها الا علي الويندوز العربي ، و هذا يسبب مشاكل عند عرض ما أعد بها أو استخدامه علي اجهزة بعض الشركات أيضا تسمية الكائنات بها ، باللغة العربية ينتج عنها بعض المشاكل فى كود الفيجوال بيزيك . لذا فإنني أفضل بشدة النسخة ذات الواجهة الانجليزية و من سابق خبرتي أن ذلك لن يسبب مشكلة كبيرة ، فمع كثرة المشاركات يفهم كل من مستخدمي النسختين أوامر الأخري ( بالمعني ) و هذا يقودنا الي فكرة عمل قاموس مصطلحات للنسختين و لنطرح هذه الفكرة ، فربما تلقي التشجيع أما بخصوص السؤال نفسه ، فانا محتفظ بنفس الرد باللغة العربية ، لبعض الأخوة و هاهو ذا : تنسيق ثم حدود وتظليل واختر حد الصفحة اختر الحد المطلوب ثم خيارات واختر من هنا نص بدلا من حاشية سيظهر لك الاطار بكامله و الحل الثاني : اذهب لإعدادات الصفحة من قائمة ملف ... ثم قم بإنقاص طول الورقة من 29.7سم إلى 28 سم مع تحياتي

الغرض منه هو تنفيذ أمر بضغط زر من أي مكان فى البرنامج ، دون الارتباط بكائن معين 1- اذهب الي جموعة الماكرو 2- اختار ماكرو جديد 3- اضغط علي الأيقون الزي عليه أحرف xyz مثلما فى الصورة 4-سيظهر عمود جديد به اسم الماكرو 5-ضع فى العمود الزر الذي تريد استخدامه و هذه بعض الامثلة فى التعليمات عن طريقة كتابة الزر طريقة الكتابة ---> ما تدل عليه ^A or ^4 ---> CTRL+A or CTRL+4 {F1} ---> F1 ^{F1} ---> CTRL+F1 +{F1} ---> SHIFT+F1 {INSERT} ---> INS ^{INSERT} ---> CTRL+INS +{INSERT} ---> SHIFT+INS {DELETE} or {DEL} ---> DEL ^{DELETE} or ^{DEL} ---> CTRL+DEL +{DELETE} or +{DEL} ---> SHIFT+DEL 6- إختار الفعل الذي تريد تخصيصه لكل زر 7- أحفظ الماكرو باسم autokeys يمكن اضافة مجموعة من ضغطات المفاتيح و لكل منها الفعل الخاص بها كما فى الصورة

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

تنسيق مختلف للخلايا التي بها كسور ، عن التي بها أرقام صحيحة =INT($G7)<>$G7 FractionConditionalFormat.rar

المثال المرفق يبين كيفية اختيار بيانات من مجال محدد عن طريق كومبو و اظهار النتيجة كصف فى مكان آخر و لأن هذه الطريقة تعيد القيمة فى خلية واحدة فقط فقد تم الاستعانة بالدالة vlookup لعرض باقي القيم أولا : من تخصيص اليقونات اضغط علي صندوق الادوات Toolbox و ختار القائمة المنسدلة combo box و ضعها فى ورقة العمل اختار القائمة المنسدلة بالزر الايمن ثم Format Control control وحدد مجال الادخال و النتيجة ( راجع المثال ) combo1.xlsx

احتجت لاعداد هذا الكود ، لانه فى بعض الاحيان تأتيني ملفات أجد حركتها بطيئة جدا بسبب تكرار لوجو لمرات كثيرة أو صورة ، نتيجة أن من أنشأ الملف ليس لديه خبرة كافية و هذا الكود يقوم بما يلي : عد الأشكال فى الملف اختيارها أو حذفها و كل منها فى ماكرو منفصل و أيضا به كودان جانبيان لادراج الوقت و التاريخ ( طبعا لاحاجة لهم لسهولة عمل ذلك بلوحة المفاتيح و لكن أتركهم فربما يحتاجهم أحد ) Sub SELECTallShapes() Application.SendKeys "{F5}{TAB}{TAB}{enter}B{enter}" End Sub Sub deleteallShapes() Application.SendKeys "{F5}{TAB}{TAB}{enter}b{enter}{del}" End Sub Sub inserttime() Application.SendKeys "^+;{ENTER}" End Sub Sub insertdate() Application.SendKeys "^;{ENTER}" End Sub Sub CountShapes() k = 0 With ActiveWorkbook.ActiveSheet.Shapes For i = 1 To .Count k = k + 1 Next Range("a1").Activate MsgBox k End With ' Set myDocument = Worksheets(1) 'myDocument.Shapes.Range(Array(1, 3)).Fill.Patterned _ msoPatternHorizontalBrick End Sub deleteshapes.zip

و هذا الكود المناظر لحذف الاسطر و هنا لم يتم اختيار مجال باسم محدد ، و لكن يتم التنفيذ بناء علي اختيار المستخدم للخلاية selection Sub deleteemptyRow() ' ' 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 If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = "" Then ActiveCell.EntireRow.Delete MyRow = MyRow - 1 End If Application.StatusBar = "Parsing / deleting ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub[/sql] DeleteemptyRows.zip

مثال لتحديد هل السجل متطابق مع غيره أم فريد ؟؟ و تحديد عدد مرات التكرار countif_if_condit.zip