السلام عليكم و رحمة الله و بركاته
قمت بعمل برنامج و فيه نماذح بقياس معين و بحجم خط مقروء و لكن ملاحظة ممن شاهد البرنامج و لأن شريحة كبيرة ممن يمكن ان يستفيدوا منه فوق الخمسين من العمر و يلجأون لتغيير دقة الشاشة لتظهر عناصرها بشكل مكبر .
فهل من طريقة سهلة لتكبير النموذج و العناصر الموجودة فيه و معها الخط و المحافظة على ترتيب النموذج بدلا من ان اقوم بالعمل يدويا مع كل ما يمكن ان يستغرقه من وقت يعني مثلا ضرب القياس الحالي في 1.3 في الاوتوكاد نستخدم امر scale فهل من كود ينفذ هذا الامر في الاكسس ؟؟
السلام عليكم
بعد البحث وجدت ما يفيدني في ما طلبته و لكن ظهرت مشكلة عندي لم اتمكن من حلها كما هو مبين في الصورة ادناه فما الحل ؟
وحدة نمطية
Option Compare Database
Option Explicit
Public Sub ResizeControls(Formular As Form, ByVal StartFormularbreite As Long, ByVal StartFormularhِhe As Long)
Dim CHANGE_FACTOR As Double
Dim CHANGE_CONTROL As Control
If Not Formular.WindowWidth = 0 Then
CHANGE_FACTOR = Formular.WindowWidth / StartFormularbreite
If Not CHANGE_FACTOR = 1 Then
On Error Resume Next '*** Nicht ganz die feine Art, ich weiك
If CHANGE_FACTOR > 1 Then
Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR
Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR
Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR
End If
For Each CHANGE_CONTROL In Formular.Controls
If CHANGE_CONTROL.ControlType = acSubform Then
Dim UFOBREITE As Integer
Dim UFOHضHE As Integer
UFOBREITE = CHANGE_CONTROL.Width
UFOHضHE = CHANGE_CONTROL.Height
CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR
CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR
CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR
CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR
ResizeControls CHANGE_CONTROL.Form, UFOBREITE, UFOHضHE
Else
CHANGE_CONTROL.Width = CHANGE_CONTROL.Width * CHANGE_FACTOR
CHANGE_CONTROL.Height = CHANGE_CONTROL.Height * CHANGE_FACTOR
CHANGE_CONTROL.Top = CHANGE_CONTROL.Top * CHANGE_FACTOR
CHANGE_CONTROL.Left = CHANGE_CONTROL.Left * CHANGE_FACTOR
CHANGE_CONTROL.FontSize = CHANGE_CONTROL.FontSize * CHANGE_FACTOR
End If
Next
If CHANGE_FACTOR < 1 Then
Formular.Section(0).Height = Formular.Section(0).Height * CHANGE_FACTOR
Formular.Section(1).Height = Formular.Section(1).Height * CHANGE_FACTOR
Formular.Section(2).Height = Formular.Section(2).Height * CHANGE_FACTOR
End If
Formular.Repaint
On Error GoTo 0
End If
End If
End Subو في حدث عند الفتح و عند التكبير للنموذج الكود التالي
Option Compare Database
Option Explicit
Dim Form_Start_Height As Long
Dim Form_Start_Width As Long
Dim Form_Current_Height As Long
Dim Form_Current_Width As Long
'
Private Sub Form_Open(Cancel As Integer)
Form_Start_Height = Me.WindowHeight
Form_Start_Width = Me.WindowWidth
Form_Current_Height = Me.WindowHeight
Form_Current_Width = Me.WindowWidth
End Sub
Private Sub Form_Resize()
ResizeControls Me, Form_Current_Width, Form_Current_Height
Form_Current_Height = Me.WindowHeight
Form_Current_Width = Me.WindowWidth
End Sub
كل الذي اقدر عليه هو الاقتراح التالي:
غير خط الكود:
ResizeControls Me, Form_Current_Width, Form_Current_Height
الى:
ResizeControls (Me, Form_Current_Width, Form_Current_Height)
اي وضعه بين قوسين ، ثم حاول!!
جعفر
تم تعديل هذه المشاركة بواسطة jjafferr في 21 مارس 2013 في 23:13
لإيضاح المشكلة ، كما اراها:
1. error Division by Zero معناه ان قيمة المقام في المعادلة هي صفر ،
وحيث ان المعادلة التي بها الخطأ هي: CHANGE_FACTOR = Formular.WindowWidth / StartFormularbreite
والمقام في المعادلة هي قيمة الخانة StartFormularbreite
2. يتم إرسال القيم من هذا السطر:
ResizeControls Me, Form_Current_Width, Form_Current_Height
واستقباله من هنا:
Public Sub ResizeControls(Formular As Form, ByVal StartFormularbreite As Long, ByVal StartFormularhِhe As Long)
وتطبيقه هنا:
CHANGE_FACTOR = Formular.WindowWidth / StartFormularbreite
وهنا يحصل الخطأ!!
3. هذا جعلني اعتقد بان هناك خطأ في ارسال القيم ، لذا اقترحت عليك:
غير خط الكود:
ResizeControls Me, Form_Current_Width, Form_Current_Height
الى:
ResizeControls (Me, Form_Current_Width, Form_Current_Height)
اي وضعه بين قوسين ، ثم حاول!!
السلام عليكم و رحمة الله و بركاته
بارك الله فيك اخي جعفر و جزاك خيرا هي المشكلة ان الاكسس يعطيني خطأ ان ابعاد النموذج الحالي و هي تمثل المقام هنا هي صفر و هذا غير معقول لان النموذج له ابعاده لو كانت صفرا لما ظهر لنا النموذج و ما رأيناه و القسمة على صفر نتيجتها هي ما لا نهاية .
ساحاول مساء اليوم ان شاء الله القيام بما ذكرته بارك الله فيك و جزاك خيرا
السلام عليكم ورحمة الله وبركاته
أخي الكريم استخدم خاصية البحث في المنتدى وستجد مايسر خاطرك ويثلج صدرك ويفرح قلبك وإليك أخي بعضها :
عَـجِبْتُ لِمَنْ يَتَفَكَّـرُ فى مَـأْكُولِهِ كَيْـفَ لا يَتَفَـكَّـرُ فى مَعْـقُـولِهِ، فَيُجَنِّبُ بَطْنَهُ ما يُؤْذيهِ، وَ يُودِعُ صَدْرَهُ ما يُرْدِيهِ
(الحسن بن علي بن أبي طالب)
إياد بيك كتب:السلام عليكم ورحمة الله وبركاته
أخي الكريم استخدم خاصية البحث في المنتدى وستجد مايسر خاطرك ويثلج صدرك ويفرح قلبك وإليك أخي بعضها :
و عليكم السلام و رحمة الله و بركاته اخي الكريم
بارك الله فيك و جزاك خيرا ساطلع على الرابطين الذين وضعتهما لي من باب زيادة العلم فقد قمت بعمل المطلوب لضيق الوقت بشكل يدوي و لكني لا زلت ارحب بكل ما يمكن ان يفيدني في هذا الموضوع
بارك الله فيك و في الاخ جعفر و جزاكما الله خيرا
المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية
جارٍ التحقق من المتواجدين…