سؤال بشان تغير نوع الخط في جميع نماذج الاكسس

[angelloay]

السلام عليكم

لدي مشكلة بسيطة

عندي ملف فيه اكثر من 50 فورم وحميع الفورمات تحتوي على ازرار ونصوص واريد تغير حجم الخط ونوعه

هل هناك كود لنغير الخط في جميع الفورمات ولجميع الكتابات والازار دفعة واحدة او اني مضطر الى تغير كل وادة بمفردها يدويا

[jjafferr]

وعليكم السلام 

 

الرابط التالي فيه طريقة وكود لتغيير الصور في جميع النماذج/التقارير ، من مضمنه الى مرتبطة ،

.

وبتغيير بسيط تستطيع ان تغيره الى طلبك ، ولاحظ ان نوع الخط الجديد هو "Andalus" في المثال

Function Convert_img_Embed_to_Link()
 
    Dim frm As AccessObject
    Dim rpt As AccessObject
    Dim dbs As Object
    Dim frm1 As Access.Form
    Dim rpt1 As Access.Report
    Dim ctl As Access.Control
    
    Set dbs = Application.CurrentProject
    
    For Each frm In dbs.AllForms

        DoCmd.OpenForm frm.Name, acDesign
        Set frm1 = Forms(frm.Name)

        For Each ctl In frm1.Controls
            If ctl.ControlType = acComboBox Or _
               ctl.ControlType = acCommandButton Or _
               ctl.ControlType = acLabel Or _
               ctl.ControlType = acListBox Or _
               ctl.ControlType = acOptionButton Or _
               ctl.ControlType = acTextBox Then
                
               Debug.Print frm.Name & " > " & ctl.ControlType & " > " & ctl.Name
               ctl.FontName = "Andalus" 
               
               If frm1.DefaultView = 2 Then
                frm1.DatasheetFontName = "Andalus"  'DataSheetForms
               End If
               
            End If
        Next ctl

        DoCmd.Close acForm, frm.Name, acSaveYes
    Next frm
    
 Exit Function

    For Each rpt In dbs.AllReports

        DoCmd.OpenReport rpt.Name, acDesign
        Set rpt1 = Reports(rpt.Name)
        
        For Each ctl In rpt1.Controls
            If ctl.ControlType = acComboBox Or _
               ctl.ControlType = acCommandButton Or _
               ctl.ControlType = acLabel Or _
               ctl.ControlType = acListBox Or _
               ctl.ControlType = acOptionButton Or _
               ctl.ControlType = acTextBox Then
               
               Debug.Print rpt.Name & " > " & ctl.ControlType & " > " & ctl.Name
               ctl.FontName = "Andalus" 
               
               If rpt1.DefaultView = 2 Then
                frm1.DatasheetFontName = "Andalus"
               End If
            
            End If
        Next ctl

        DoCmd.Close acReport, rpt.Name, acSaveYes
    Next rpt
    
    
End Function

 

 

جعفر

 

تم تعديل ديسمبر 8, 2016 بواسطه jjafferr
تم تعديل الكود

[angelloay]

شكرا لك ولكن لم اعرف اين اضع الكود في الفورم الرئيسي او موديل جديد ؟؟؟؟؟

طريقة التطبيق بعد اذنك

[jjafferr]

وعليكم السلام

 

الرابط الذي ارفقته لك في مشاركتي السابقة فيه الخطوات

 

جعفر

[angelloay]

الطريقة لم تنجح يقف عند فورم معين ويعطي خطا عند سطر الخط هل يوجد طريقة اخرى او هل تاكدت من الكود؟؟؟؟

[jjafferr]

اخي الفاضل

 

حتى نستطيع ان نساعدك ، يجب ان نستطيع فهم ملاحظتك ، ويجب ان تعطينا اين المشكلة ونوع المشكلة ورقم الخطأ وووو !!

مجرد " الطريقة لم تنجح يقف عند فورم معين ويعطي خطا عند سطر الخط " لا تعطينا معلومة كافية لمعرفة اي من اسطر الكود الـ 43 فيها المشكلة ، او اذا كان في نموذجك شئ خاص!!

 

هل تاكدت من الكود؟؟؟؟

لا ، ليس على برنامجك ، ولكن بالاشارة الى الرابط السابق ، فالكود اشتغل تمام هناك

 

جعفر

[angelloay]

انتظر قليلا فقط

 

صورة الخطا

[jjafferr]

هل النماذج التي انتهى منها الكود ، هل تم تغيير نوع الخط فيها الى "الاندلس" (ستلاحظ اسماء النماذج التي انتهى منها الكود في الشاشة اسفل الكود ، ولكن ليس اسم النموذج الاخير) ؟

اسم النموذج الاخير هو النموذج الذي فيه المشكلة ، فهل بالامكان ارفاقه وبدون بقية البرنامج.

 

جعفر

[angelloay]

لم يتغير الخط ولا باي طريقة ولا باي فورم مسجل اسمه او لم يسجل

[jjafferr]

لوسمحت ترفق برنامجك حتى القي نظرة عليه ،

3 ساعات مضت, angelloay said:

هل تاكدت من الكود؟؟؟؟

نعم ، على احد برامج المنتدى المليئ بالنماذج والتقارير ، وقبل ان ارفق لك الكود لك.

 

جعفر

[angelloay]

بعد التاكد قام بتغير عدد قليل من النماذج / الفورم / فقمت بالتالي لتلافي الخطا في الفورم

غيرت اسم النموذج ليكون اخر نموذج في البرنامج

قمت بتشغيل الموديل

قام بتغير عدد من الفورمات ولكن بدون نماذج الاستعلامات

الك النتيجة

 

[jjafferr]

17 دقائق مضت, jjafferr said:

لوسمحت ترفق برنامجك حتى القي نظرة عليه ،

 

ولا داعي للجداول ، اريد النماذج والتقارير فقط.

قد تكون المشكلة في النموذج الفرعي ، فلم اجرب هذا.

 

جعفر

[angelloay]

 

قم بفك الضغط في القرص d وياريت لو في طريقة تفير الخط في الاستدعاءات والتقارير الفرعية اكون شاكر لك

تم تعديل ديسمبر 8, 2016 بواسطه jjafferr
تم انزال البرنامج ، وازالت الرابط من المشاركة

[jjafferr]

اخي الفاضل

 

في سطر في الكود لازم نحذفه (مكرر مرتين ، فلازم نحذفه مرتين) ،

فبدل ان اكتبه هنا ، فقد اصلحت الكود في مشاركتي الاصليه اعلاه ، وتستطيع ان تنسخه الى برنامجك وتجربته ، وقد جربته واشتغل تمام

شكرا على التنبيه

 

جعفر

[angelloay]

اخي جعفر لقد عمل الكود بنسبة 90% ولكن باقي النماذج الفرعية لم تعمل ولم استطع تغير الخط ولو حتى يدويا

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

وان لك من الشاكرين

[jjafferr]

1 ساعه مضت, angelloay said:

اخي جعفر لقد عمل الكود بنسبة 90% ولكن باقي النماذج الفرعية لم تعمل ولم استطع تغير الخط ولو حتى يدويا

انا عندي عمل بنسبة 100% ، فما اسم النموذج الفرعي الذي لم يعمل؟

وهل كلامنا عن البرنامج Accurate.accdb ؟

 

جعفر

[angelloay]

انظر مثال في المرفق

جميع النماذج الفرعية لم تعمل

استاذ عندك فيس بوك او طريقة للتواصل لازم استشيرك بشغلة اذا في مجال

تم تعديل ديسمبر 8, 2016 بواسطه angelloay

[jjafferr]

شكرا على ملاحظتك 

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

وعليه ، فالامر يخص النموذج وليس الحقل ، وقد تم اضافة هذه الخاصية للكود اعلاه ، فالرجاء تجربة الكود مرة اخرى

 

وحاولت النظر في فهارس جداولك ، ولكني اقفلت كل شئ وبسرعة لما رأيت العلاقات بين الجداول 

فهرست الحقول المرتبطة في الاستعلام ، وفهرست الحقول التي بها شروط في الاستعلام (طبعا الفهرسة تكون في الجداول) ، هي مفتاح سرعة البرنامج ،

ولكن الاكسس فيه نظام يستطيع مساعدتك في فحص قاعدة بياناتك ، واعطائك الاقتراحات لتعديل وتسريع برامجك ، وتاكد انك تختار جميع الكائنات في تبويب النماذج والجداول ووو:

.

.

وليس عندي حساب في الفيس بوك ولا واتسب اب ولا فايبر ولا .... ، ولو كان عندي ايهم ، لما استطعت ان اساهم في المنتدى بهذه الطريقة

 

جعفر

[moamen salem]

اقسم بالله الف الف شكر .... ما شاء الله علي حضرتك وجزاك الله خير حليت مشكلة كبيرة عندي

ولكن بعد اذنك عملت تعديلين عندي عشان الكود وقف اكثر من مرة وهي 

1- عملت كود النماذج وحده والتقارير لوحده في وحدة نمطية منفصلة

2- ضيفت الكود دا قبل كل وحدة نمطية عشان لو قابل مشاكل ميقفش

On Error Resume Next

جزاك الله خير مرة اخري

[ابو جودي]

في ٧‏/٨‏/٢٠٢١ at 13:45, moamen salem said:

اقسم بالله الف الف شكر .... ما شاء الله علي حضرتك وجزاك الله خير حليت مشكلة كبيرة عندي

ولكن بعد اذنك عملت تعديلين عندي عشان الكود وقف اكثر من مرة وهي 

1- عملت كود النماذج وحده والتقارير لوحده في وحدة نمطية منفصلة

2- ضيفت الكود دا قبل كل وحدة نمطية عشان لو قابل مشاكل ميقفش

On Error Resume Next

جزاك الله خير مرة اخري

لا تحتاج الى عمل وحدة نمطية اكثر من مرة ولا تحتاج الى تكرار الاكواد بدون داعى 

فقط لابد من إزالة  Exit Function

وموقعها في الكود بين الروتين الذى يتم تطبيقه على النماذج  والروتين الذى يتم تطبيقه على التقارير 

ولم يتم تغيير الخط فقط في التقارير بسبب الخروج من الروتين بسبب هذا السطر 

والأفضل من استخدام On Error Resume Next
استخدام كود تصيد الأخطاء ErrorHandler لتتمكن من الوقوف على سبب ومكان وتوصيف ورقم الخطأ 

وتمت التعديلات كالاتي
 

 

• إزالة  Exit Function  
• تغيير اسم الروتين العام حتى يتناسب مع الوظيفة التي يقوم بها ليسهل مستقبلا لأى مطور التعامل بسهولة في قاعدة البيانات
• إضافة كود تصيد الأخطاء ErrorHandler  للوقوف على سبب ومكان وتوصيف ورقم الأخطاء حتى يسهل تفاديها إن وجدت أخطاء
• إضاقة متغير ثابت في أول الكود ليتم وضع اسم الخط فقط مرة واحدة في الروتين من باب المرونة والتسهيل على المطور

ملاحظة هامة جدا جدا  لابد من تغير اسم الخط الذى قمت انا باستخدامه في الوحدة النمطية وهو  Calibri (Detail) باسم الخط الذى تريد أنت التغيير إليه 
وقمت بوضع هذا التلميح للتذكير في الوحدة النمطية عند المتغير الثابت الذى يحمل اسم الخط  <<---------<  Font name must be changed here between the quotation marks

يتم استدعاء الكود من خلالChange Font.mdb

  Call ApplyDefaultFont

وأخيرا الروتين والذى يتم وضعه داخل وحدة نمطية

Function ApplyDefaultFont()

On Error GoTo ErrorHandler

Const strFontName = "Calibri (Detail)"    ' <<---------<  Font name must be changed here between the quotation marks

Dim frm           As AccessObject
Dim rpt           As AccessObject
Dim dbs           As Object
Dim frm1          As Access.Form
Dim rpt1          As Access.Report
Dim ctl           As Access.Control
        
Set dbs = Application.CurrentProject
  ' Apply Default Font for All Forms
  For Each frm In dbs.AllForms
    DoCmd.OpenForm frm.Name, acDesign
    Set frm1 = Forms(frm.Name)
      For Each ctl In frm1.Controls
        If ctl.ControlType = acComboBox Or _
           ctl.ControlType = acCommandButton Or _
           ctl.ControlType = acLabel Or _
           ctl.ControlType = acListBox Or _
           ctl.ControlType = acOptionButton Or _
           ctl.ControlType = acTextBox Then
           ctl.FontName = strFontName
           'Debug.Print frm.Name & " > " & ctl.ControlType & " > " & ctl.Name
              If frm1.DefaultView = 2 Then
                frm1.DatasheetFontName = strFontName
              End If
         End If
      Next ctl
      DoCmd.Close acForm, frm.Name, acSaveYes
  Next frm
  ' Apply Default Font for All Reports
    For Each rpt In dbs.AllReports
        DoCmd.OpenReport rpt.Name, acDesign
        Set rpt1 = Reports(rpt.Name)
          For Each ctl In rpt1.Controls
            If ctl.ControlType = acComboBox Or _
               ctl.ControlType = acCommandButton Or _
               ctl.ControlType = acLabel Or _
               ctl.ControlType = acListBox Or _
               ctl.ControlType = acOptionButton Or _
               ctl.ControlType = acTextBox Then
               ctl.FontName = strFontName
               'Debug.Print rpt.Name & " > " & ctl.ControlType & " > " & ctl.Name
                  If rpt1.DefaultView = 2 Then
                    frm1.DatasheetFontName = strFontName
                  End If
            End If
        Next ctl
        DoCmd.Close acReport, rpt.Name, acSaveYes
    Next rpt

    Set frm = Nothing
    Set rpt = Nothing
    Set dbs = Nothing
    Set frm1 = Nothing
    Set rpt1 = Nothing
    Set ctl = Nothing
    Exit Function

ExitHandler:
   Exit Function
ErrorHandler:
   MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description
   
End Function

 وهذا مرفق التطبيق لتعم الفائدة ويكون مرجعا سهلا ان شاء الله

Change Font.mdb

[الحلبي]

بشمهندس / @ابا جودى

الله عليك فى هذا التوضيح وهذا التنظيم  الذى اعتبره فوق العادة

الله يصلح حالك ويعفو عنك ويعيطيك الصحة يارب

[moamen salem]

7 ساعات مضت, ابا جودى said:

لا تحتاج الى عمل وحدة نمطية اكثر من مرة ولا تحتاج الى تكرار الاكواد بدون داعى 

فقط لابد من إزالة  Exit Function

وموقعها في الكود بين الروتين الذى يتم تطبيقه على النماذج  والروتين الذى يتم تطبيقه على التقارير 

ولم يتم تغيير الخط فقط في التقارير بسبب الخروج من الروتين بسبب هذا السطر 

والأفضل من استخدام On Error Resume Next
استخدام كود تصيد الأخطاء ErrorHandler لتتمكن من الوقوف على سبب ومكان وتوصيف ورقم الخطأ 

وتمت التعديلات كالاتي
 

 

• إزالة  Exit Function  
• تغيير اسم الروتين العام حتى يتناسب مع الوظيفة التي يقوم بها ليسهل مستقبلا لأى مطور التعامل بسهولة في قاعدة البيانات
• إضافة كود تصيد الأخطاء ErrorHandler  للوقوف على سبب ومكان وتوصيف ورقم الأخطاء حتى يسهل تفاديها إن وجدت أخطاء
• إضاقة متغير ثابت في أول الكود ليتم وضع اسم الخط فقط مرة واحدة في الروتين من باب المرونة والتسهيل على المطور

ملاحظة هامة جدا جدا  لابد من تغير اسم الخط الذى قمت انا باستخدامه في الوحدة النمطية وهو  Calibri (Detail) باسم الخط الذى تريد أنت التغيير إليه 
وقمت بوضع هذا التلميح للتذكير في الوحدة النمطية عند المتغير الثابت الذى يحمل اسم الخط  <<---------<  Font name must be changed here between the quotation marks

يتم استدعاء الكود من خلالChange Font.mdb

  Call ApplyDefaultFont

وأخيرا الروتين والذى يتم وضعه داخل وحدة نمطية

Function ApplyDefaultFont()

On Error GoTo ErrorHandler

Const strFontName = "Calibri (Detail)"    ' <<---------<  Font name must be changed here between the quotation marks

Dim frm           As AccessObject
Dim rpt           As AccessObject
Dim dbs           As Object
Dim frm1          As Access.Form
Dim rpt1          As Access.Report
Dim ctl           As Access.Control
        
Set dbs = Application.CurrentProject
  ' Apply Default Font for All Forms
  For Each frm In dbs.AllForms
    DoCmd.OpenForm frm.Name, acDesign
    Set frm1 = Forms(frm.Name)
      For Each ctl In frm1.Controls
        If ctl.ControlType = acComboBox Or _
           ctl.ControlType = acCommandButton Or _
           ctl.ControlType = acLabel Or _
           ctl.ControlType = acListBox Or _
           ctl.ControlType = acOptionButton Or _
           ctl.ControlType = acTextBox Then
           ctl.FontName = strFontName
           'Debug.Print frm.Name & " > " & ctl.ControlType & " > " & ctl.Name
              If frm1.DefaultView = 2 Then
                frm1.DatasheetFontName = strFontName
              End If
         End If
      Next ctl
      DoCmd.Close acForm, frm.Name, acSaveYes
  Next frm
  ' Apply Default Font for All Reports
    For Each rpt In dbs.AllReports
        DoCmd.OpenReport rpt.Name, acDesign
        Set rpt1 = Reports(rpt.Name)
          For Each ctl In rpt1.Controls
            If ctl.ControlType = acComboBox Or _
               ctl.ControlType = acCommandButton Or _
               ctl.ControlType = acLabel Or _
               ctl.ControlType = acListBox Or _
               ctl.ControlType = acOptionButton Or _
               ctl.ControlType = acTextBox Then
               ctl.FontName = strFontName
               'Debug.Print rpt.Name & " > " & ctl.ControlType & " > " & ctl.Name
                  If rpt1.DefaultView = 2 Then
                    frm1.DatasheetFontName = strFontName
                  End If
            End If
        Next ctl
        DoCmd.Close acReport, rpt.Name, acSaveYes
    Next rpt

    Set frm = Nothing
    Set rpt = Nothing
    Set dbs = Nothing
    Set frm1 = Nothing
    Set rpt1 = Nothing
    Set ctl = Nothing
    Exit Function

ExitHandler:
   Exit Function
ErrorHandler:
   MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description
   
End Function

 وهذا مرفق التطبيق لتعم الفائدة ويكون مرجعا سهلا ان شاء الله

Change Font.mdb 348 kB · 3 downloads

مميز كالعادة يا استاذنا جعله الله في ميزان حسناتك 

[hamdynose]

السلام عليكم وبارك الله فيكم وكل عام وانتم بخير 

نرجوا وضع كود لفتح نموذج frmChangeFont  مرة اخرى بعد تغيير الخطوط 

وجزاكم الله خيرا

[ابو جودي]

6 ساعات مضت, hamdynose said:

السلام عليكم وبارك الله فيكم وكل عام وانتم بخير 

نرجوا وضع كود لفتح نموذج frmChangeFont  مرة اخرى بعد تغيير الخطوط 

وجزاكم الله خيرا

اتفضل يا سيدى 

 

 

Change Font (2).mdb

[hamdynose]

بارك الله فيكم واصلح بالكم ورزقكم من الطيبات

تحياتى اخى الفاضل