أبو آدم

للحصول على أنواع الخطوط المثبتة على جهازك برمجياً http://www.officena.net/ib/index.php?showtopic=45994 .............

إخوتي الفضلاء نحتاج أحياناً للتعرف على أنواع الخطوط الموجودة على جهاز كل منا ، للحصول على قائمة بأسماء الخطوط المتاحة على جهازك برمجيا مع مثال نصي لنوع الخط ضمن جدول في مستند يتم إنشاؤه حديثا ، نقدم اليوم هذا الحلّ البرمجي. كيفية الاستخدام: فتح مستند Word. اضغط على Alt + F11 لفتح VBE. إدراج وحدة نمطية. (Insert -> module) لصق الكود التالي هناك في يمين الإطار Option Explicit Sub ListAllFonts() Dim oDoc As Word.Document Dim oTable As Word.Table Dim iCnt As Long If MsgBox("Do you wish to build a list?" & vbCr & _ "Building a list on older systems this may take a while" & vbCr & _ vbCr & "Screen may appear frozen" & vbCr & _ "Please wait for the list to complete", _ vbQuestion + vbYesNo, "Built Font list") = vbYes Then Application.ScreenUpdating = False 'Create new doc to list font's Set oDoc = Application.Documents.Add 'Create table of 2 columns and as many rows as there are fontnames Set oTable = oDoc.Tables.Add(Range:=Selection.Range, _ NumRows:=Application.FontNames.Count + 1, _ NumColumns:=2) With oTable 'Create table header With .Cell(1, 1).Range .Font.Name = "Arial" .Font.Bold = True .InsertAfter "Font Name" End With With .Cell(1, 2).Range .Font.Name = "Arial" .Font.Bold = True .InsertAfter "Font Example" End With 'Loop through Fontnames For iCnt = 1 To Application.FontNames.Count 'Add Fontname to cell With .Cell(iCnt + 1, 1).Range .Font.Name = "Arial" .Font.Size = 10 .InsertAfter Application.FontNames(iCnt) End With 'Set Font in Cell to Fontname and insert example text With .Cell(iCnt + 1, 2).Range .Font.Name = Application.FontNames(iCnt) .Font.Size = 10 .InsertAfter "ABCDEFG 1234567890 hijklmnop" End With Next iCnt 'No borders and sort table Ascending .Borders.Enable = False .Sort SortOrder:=wdSortOrderAscending End With End If End Sub إغلاق VBE Alt+ Q أو اضغط على X في الزاوية اليمنى العليا حفظ الملف. اختبار التعليمات البرمجية: من Word، اضغط Alt + F8 لفتح مربع حوار الماكرو. حدد ListAllFonts انقر فوق تشغيل. والمرفق لتوضيح التطبيق والله من وراء القصد وهو حسبي .......... NA_ListInstalledFonts.zip

في خصائص مربع التحرير LimitToList=Yes AutoExpand=No تظهر رسالة من النظام تطلب الالتزام بالقائمة .....

تحديد الاصدار الذي تستخدمه سيعيننا على الاجابة على تساؤلاتك 2003 . 2007 . 2010 .............

جرب في حدث عند النقر لزر الأمر في النموذج DoCmd.Close DoCmd.OpenForm "form1" وفي حدث عند الإغلاق للتقرير DoCmd.OpenForm "form1"

أرفق القاعدة حتى نتمكن من مساعدتك .!!!!!!! ..........

هل يمكن توضيح الفكرة ، ببعض التفصيل فالحكم على الشيئ فرع عن تصوره ..............

مساهمة طيبة ... و حلّ مناسب أخي أبو ندى ليس في العلم "جوع" ولكنه شغف ... وسعي ... وطلب ... وهمّة ندعوا لك بالتوفيق

طلبك غير واضح النموذج الثاني مصدر معلوماته tbl2 حاول توضيح الفكرة أكثر ............

دعوة طيبة لطيب http://www.officena.net/ib/index.php?showannouncement=21&f=89 ............

نسأل الله أن يرفع الغمّة ... ويحقن الدماء المسلمة ... ويثبت أهل الحقّ ونبقى بإنتظار عودتك الميمونة ... ...........

المرفق 2003 ........... الاتصالات.rar

دعوة طيبة لطيب http://www.officena.net/ib/index.php?showannouncement=21&f=89 ...........

أخي حازم إن كنت قد أحسنت الفهم عنك في Query1 تاريخ آخر زيادة لكل موظف في Query2 تاريخ آخر زيادة لكل موظف وقيمتها المرفق 2003 و 2007 ............ والله من وراء القصد وهو حسبي ........... NA_LastIncreaseForEachEmployee.rar

أخي العزيز في محرر الفيجوال للنموذج إنسخ الكود Private Sub borrower_Change() If Me.borrower = "هيئة تدريس" Then Me.Specialization.Enabled = True Me.Specialization.SetFocus Else Me.Specialization.Enabled = False Me.Saff.SetFocus End If End Sub ووافني بالنتيجة والله من وراء القصد

دعوة طيبة لطيب http://www.officena.net/ib/index.php?showannouncement=21&f=89 .........

أحسن الله اليك أبا عمر فيما أحسنت من الدعاء أجبت في طرحي على عموم ما فهمت من طلبك الأول ...... أنا لم أطلع على التطبيق الذي تتحدث عنه للأخ رضا وعموماً ... في 2003 التطبيق يكون على كامل النص (فيما أعلم) وبعد ما فصّلت في القول ... آملاً أن أكون قد أحسنت الفهم عنك ... نعيد النظر في التفصيل ... ولكن قد أحتاج لإجابة منك عن بعض الأسئلة في حينه والله من وراء القصد وهو حسبي .. ...........

جزيت خيراً أبا عمر بانتظار تعليقاتكم بعد التطبيق .... NA_FontProperties.rar

نتابع خلف مربع تحرير وسرد للتحكم في حجم النص ، ننسخ الكود Private Sub Combo13_Change() Forms("Form1").Controls("Text0").FontSize = Me.Combo13 End Sub خلف مربع تحرير وسرد للتحكم في إسم الخط ، ننسخ الكود Private Sub Combo15_Change() Forms("Form1").Controls("Text0").FontName = Me.Combo15 End Sub خلف مربع تحرير وسرد للتحكم في محاذاة النص ، ننسخ الكود Private Sub Combo4_Change() Select Case [Combo4] Case "General" Forms("Form1").Controls("Text0").TextAlign = 0 Case "Left" Forms("Form1").Controls("Text0").TextAlign = 1 Case "Center" Forms("Form1").Controls("Text0").TextAlign = 2 Case "Right" Forms("Form1").Controls("Text0").TextAlign = 3 Case "Distribute" Forms("Form1").Controls("Text0").TextAlign = 4 End Select End Sub وللحديث بقية .... .........

نتابع لإستعادة الوضع الافتراضي للنص في مربع النص المستهدف ، ننشيئ روتيناً بسيطاً في النموذج ، حيث ننسخ في محرر الفيجوال Private Sub fDefault() Me.Text0.FontBold = False Me.Toggle22 = False Me.Text0.FontItalic = False Me.Toggle23 = False Me.Text0.FontUnderline = False Me.Toggle24 = False Me.Text0.FontSize = 12 Me.Combo13 = 12 Me.Text0.FontName = "Arial" Me.Combo15 = "Arial" Me.Text0.TextAlign = 3 Me.Combo4 = "Right" End Sub حيث نقوم بإستدعاء هذا الروتين كلما إحتجنا اليه ، ومن ذلك ، خلف زر أمر إستعادة الوضع الافتراضي ، وفي حدث عند التحميل للنموذج ، حيث نقوم بالاستدعاء بإستخدام Call fDefault وللحديث بقية .... ......

نتابع نحتاج لإنشاء ثلاثة أزرار تبديل (كما سبق) ، ويتم إنشاء أزرار التبديل كما هو موضح بالصورة صورة مرفقة ... زر تبديل للتحكم في سماكة الحروف BOLD وننسخ خلفه الكود Private Sub Toggle22_Click() If Me.Toggle22 Then Me.Text0.FontBold = False Else Me.Text0.FontBold = True End If Me.Text0.FontBold = Me.Toggle22 End Sub زر تبديل للتحكم في الخط المائل وننسخ خلفه الكود Private Sub Toggle23_Click() If Me.Toggle23 Then Me.Text0.FontItalic = False Else Me.Text0.FontItalic = True End If Me.Text0.FontItalic = Me.Toggle23 End Sub زر تبديل للتحكم في وضع خط تحت النص وننسخ خلفه الكود Private Sub Toggle24_Click() If Me.Toggle24 Then Me.Text0.FontUnderline = False Else Me.Text0.FontUnderline = True End If Me.Text0.FontUnderline = Me.Toggle24 End Sub و للحديث بقية .... ...........

نتابع مربع تحرير وسرد للتحكم في إسم الخط ، نجعله في رأس النموذج ، ويكون مصدر الصف فيه من جدول أنواع الخطوط tblFontName وسيكون جزءاً من التطبيق المرفق في نهاية الشرح ، وقد نتحدث لاحقاً بإذن الله عن كيفية الحصول على قائمة بإسماء الخطوط الموجودة على الجهاز . صورة مرفقة .. ......... مربع تحرير وسرد للتحكم في محاذاة النص ، نجعله في رأس النموذج ، ويكون نوع مصدر الصف في خصائصه Value List ومصدر الصف قيم مختارة تمثل أوضاع المحاذاة المتوفرة وهي General;Left;Center;Right;Distribute وللحديث بقية ... ..........

نتابع مربع النص المستهدف نجعله في تفاصيل النموذج ويكون غير منضم (للتجرية و التطبيق) ، ونجعل له في خصائصه (القيمة الافتراضية) نصاً بسيطاً مربع تحرير وسرد للتحكم في حجم النص : نجعله في رأس النموذج ، ويكون نوع مصدر الصف في خصائصه Value List ومصدر الصف أرقام مختارة حسب رغبتك (لا تقل عن 8) ومثلاً 8;9;10;11;12;13;14;17;22;24 فائدة : ولا بد هنا أن يفصل بين كل رقم و لاحقه فاصلة منقوطة وللحديث بقية .... .........

أخي ابا عمر نحتاج في النموذج : مربع نص مستهدف مربع تحرير وسرد للتحكم في حجم النص مربع تحرير وسرد للتحكم في إسم الخط مربع تحرير وسرد للتحكم في محاذاة النص زر تبديل للتحكم في سماكة الحروف BOLD زر تبديل للتحكم في الخط المائل زر تبديل للتحكم في وضع خط تحت النص زر أمر لإستعادة الوضع الافتراضي للنص في مربع النص المستهدف وللحديث بقية ....... .............