ابو عبد الرحمن اشرف قام بنشر مايو 19, 2023 مشاركة قام بنشر مايو 19, 2023 اخواني الاعزاء الفضلاء واساتذتي الكرام لقد قمت بعمل تعديلات علي النماذج وتم وضعها في برنامج العميل فاشتكي ان النموذج لم يظهر بالكامل فهل هناك حل بكود يحل الامر اتوماتيكيا بدل التغيير في كل نموذج حتي يتلائم مع دقة شاشة العميل مثال علي نمذج erad الي حضراتكم المرفق عقاري.rar 1 رابط هذا التعليق شارك More sharing options...
أفضل إجابة kkhalifa1960 قام بنشر مايو 19, 2023 أفضل إجابة مشاركة قام بنشر مايو 19, 2023 تفضل أخي هذه المشاركة للأخت زهره العبد الله جزاها الله كل الخير . 1 رابط هذا التعليق شارك More sharing options...
ابو عبد الرحمن اشرف قام بنشر مايو 20, 2023 الكاتب مشاركة قام بنشر مايو 20, 2023 1 ساعه مضت, kkhalifa1960 said: تفضل أخي هذه المشاركة للأخت زهره العبد الله جزاها الله كل الخير . اخي الحبيب خليفة ما فهمته بناءا علي ما قرأته وهو اذا رغبت في وضع الكود الموضوع تحت زر الامر " اعادة التحجيم " في حدث عند الفتح او التحميل فلا يوجد مشكله . نضع هذا الحدث في النموذج عند الفتح On Error Resume Next ReSizeForm Me 'اعادة تحجيم النموذج الرئيسي ReSizeForm subForm.Form 'اعادة تحجيم النموذج الفرعي Me.cmdClose.SetFocus Me.cmdResize.Enabled = False ثم ننسخ الوحدة النمطية هذه الي قاعدة البيانات Option Compare Database Option Explicit 'قم بتغيير الارقام بناء على دقة الشاشة التي سوف تستخدمها للعرض مثلا 640 × 480 او 800 × 600 او 1024 × 768 بيكسل Private Const DESIGN_HORZRES As Long = 640 Private Const DESIGN_VERTRES As Long = 480 'مقدار عدد البكسلات في البوصة الواحده 96 يفضل تركه كما هو لانه قياسي Private Const DESIGN_PIXELS As Long = 96 Private Const WM_HORZRES As Long = 8 Private Const WM_VERTRES As Long = 10 Private Const WM_LOGPIXELSX As Long = 88 Private Const TITLEBAR_PIXELS As Long = 18 Private Const COMMANDBAR_PIXELS As Long = 26 Private Const COMMANDBAR_LEFT As Long = 0 Private Const COMMANDBAR_TOP As Long = 1 Private OrigWindow As tWindow Private Type tRect left As Long Top As Long right As Long bottom As Long End Type Private Type tDisplay Height As Long Width As Long DPI As Long End Type Private Type tWindow Height As Long Width As Long End Type Private Type tControl Name As String Height As Long Width As Long Top As Long left As Long End Type Private Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _ (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" _ () As Long Private Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" _ (ByVal hwnd As Long) As Long Private Declare Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" _ (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function WM_apiGetWindowRect Lib "user32.dll" Alias "GetWindowRect" _ (ByVal hwnd As Long, lpRect As tRect) As Long Private Declare Function WM_apiMoveWindow Lib "user32.dll" Alias "MoveWindow" _ (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _ ByVal nHeight As Long, ByVal bRepaint As Long) As Long Private Declare Function WM_apiIsZoomed Lib "user32.dll" Alias "IsZoomed" _ (ByVal hwnd As Long) As Long 'الغرض من هذه الوظيفة هو احضار معلومات الطول والعرض والبيكسل الحالي لشاشة العرض Private Function getScreenResolution() As tDisplay Dim hDCcaps As Long Dim lngRtn As Long On Error Resume Next hDCcaps = WM_apiGetDC(0) With getScreenResolution .Height = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES) .Width = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES) .DPI = WM_apiGetDeviceCaps(hDCcaps, WM_LOGPIXELSX) End With lngRtn = WM_apiReleaseDC(0, hDCcaps) End Function 'الغرض من هذه الوظيفة هو اعادة قيم عناصر النموذج كاملة في الطول والعرض وتكبيرها حسب مقاس الشاشة الحالية Private Function getFactor(blnVert As Boolean) As Single Dim sngFactorP As Single On Error Resume Next If getScreenResolution.DPI <> 0 Then sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI Else sngFactorP = 1 End If If blnVert Then getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP Else getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP End If End Function 'الغرض من هذه الوظيفة هي القيام بإستدعاءها في حدث عند الفتح وعند التحميل Public Sub ReSizeForm(ByVal frm As Access.Form) Dim rectWindow As tRect Dim lngWidth As Long Dim lngHeight As Long Dim sngVertFactor As Single Dim sngHorzFactor As Single Dim sngFontFactor As Single On Error Resume Next sngVertFactor = getFactor(True) sngHorzFactor = getFactor(False) sngFontFactor = VBA.IIf(sngHorzFactor < sngVertFactor, sngHorzFactor, sngVertFactor) Resize sngVertFactor, sngHorzFactor, sngFontFactor, frm If WM_apiIsZoomed(frm.hwnd) = 0 Then Access.DoCmd.RunCommand acCmdAppMaximize Call WM_apiGetWindowRect(frm.hwnd, rectWindow) With rectWindow lngWidth = .right - .left lngHeight = .bottom - .Top End With If frm.Parent.Name = VBA.vbNullString Then Call WM_apiMoveWindow(frm.hwnd, ((getScreenResolution.Width - _ (sngHorzFactor * lngWidth)) / 2) - getLeftOffset, _ ((getScreenResolution.Height - (sngVertFactor * lngHeight)) / 2) - _ getTopOffset, lngWidth * sngHorzFactor, lngHeight * sngVertFactor, 1) End If End If Set frm = Nothing End Sub 'الغرض من هذه الوظيفة هي اعادة تحجيم مقاسات الاقسام الخاصة بالنموذج مثل قسم تفصيل وقسم رأس النموذج وتذييل النموذج Private Sub Resize(sngVertFactor As Single, sngHorzFactor As Single, sngFontFactor As _ Single, ByVal frm As Access.Form) Dim ctl As Access.Control Dim arrCtls() As tControl Dim lngI As Long Dim lngJ As Long Dim lngWidth As Long Dim lngHeaderHeight As Long Dim lngDetailHeight As Long Dim lngFooterHeight As Long Dim blnHeaderVisible As Boolean Dim blnDetailVisible As Boolean Dim blnFooterVisible As Boolean Const FORM_MAX As Long = 31680 On Error Resume Next With frm .Painting = False lngWidth = .Width * sngHorzFactor lngHeaderHeight = .Section(Access.acHeader).Height * sngVertFactor lngDetailHeight = .Section(Access.acDetail).Height * sngVertFactor lngFooterHeight = .Section(Access.acFooter).Height * sngVertFactor .Width = FORM_MAX .Section(Access.acHeader).Height = FORM_MAX .Section(Access.acDetail).Height = FORM_MAX .Section(Access.acFooter).Height = FORM_MAX blnHeaderVisible = .Section(Access.acHeader).Visible blnDetailVisible = .Section(Access.acDetail).Visible blnFooterVisible = .Section(Access.acFooter).Visible .Section(Access.acHeader).Visible = False .Section(Access.acDetail).Visible = False .Section(Access.acFooter).Visible = False End With ReDim arrCtls(0) For Each ctl In frm.Controls If ((ctl.ControlType = Access.acTabCtl) Or _ (ctl.ControlType = Access.acOptionGroup)) Then With arrCtls(lngI) .Name = ctl.Name .Height = ctl.Height .Width = ctl.Width .Top = ctl.Top .left = ctl.left End With lngI = lngI + 1 ReDim Preserve arrCtls(lngI) End If Next ctl For Each ctl In frm.Controls If ctl.ControlType <> Access.acPage Then With ctl .Height = .Height * sngVertFactor .left = .left * sngHorzFactor .Top = .Top * sngVertFactor .Width = .Width * sngHorzFactor .FontSize = .FontSize * sngFontFactor Select Case .ControlType Case Access.acListBox .ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor) Case Access.acComboBox .ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor) .ListWidth = .ListWidth * sngHorzFactor Case Access.acTabCtl .TabFixedWidth = .TabFixedWidth * sngHorzFactor .TabFixedHeight = .TabFixedHeight * sngVertFactor End Select End With End If Next ctl For lngJ = 0 To lngI With frm.Controls.Item(arrCtls(lngJ).Name) .left = arrCtls(lngJ).left * sngHorzFactor .Top = arrCtls(lngJ).Top * sngVertFactor .Height = arrCtls(lngJ).Height * sngVertFactor .Width = arrCtls(lngJ).Width * sngHorzFactor End With Next lngJ With frm .Width = lngWidth .Section(Access.acHeader).Height = lngHeaderHeight .Section(Access.acDetail).Height = lngDetailHeight .Section(Access.acFooter).Height = lngFooterHeight .Section(Access.acHeader).Visible = blnHeaderVisible .Section(Access.acDetail).Visible = blnDetailVisible .Section(Access.acFooter).Visible = blnFooterVisible .Painting = True End With Erase arrCtls Set ctl = Nothing End Sub 'الغرض من هذه الوظيفة هو حساب مجموع البيكسل لكامل شاشة الاكسيس ناحية اليمين ووضع النموذج في منتصف الشاشة Private Function getTopOffset() As Long Dim cmdBar As Object Dim lngI As Long On Error GoTo err For Each cmdBar In Application.CommandBars If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_TOP)) Then lngI = lngI + 1 End If Next cmdBar getTopOffset = (TITLEBAR_PIXELS + (lngI * COMMANDBAR_PIXELS)) exit_fun: Exit Function err: getTopOffset = TITLEBAR_PIXELS + COMMANDBAR_PIXELS Resume exit_fun End Function 'الغرض من هذه الوظيفة هو حساب مجموع البيكسل لكامل شاشة الاكسيس ناحية اليسار ووضع النموذج في منتصف الشاشة Private Function getLeftOffset() As Long Dim cmdBar As Object Dim lngI As Long On Error GoTo err For Each cmdBar In Application.CommandBars If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_LEFT)) Then lngI = lngI + 1 End If Next cmdBar getLeftOffset = (lngI * COMMANDBAR_PIXELS) exit_fun: Exit Function err: getLeftOffset = 0 Resume exit_fun End Function 'الغرض من هذه الوظيفة هو اعادة تحجيم كامل عرض الاعمدة وعدم ترك فراغات من الناحية اليسرى Private Function adjustColumnWidths(strColumnWidths As String, sngFactor As Single) As String On Error GoTo Err_adjustColumnWidths Dim astrColumnWidths() As String Dim strTemp As String Dim lngI As Long Dim lngJ As Long ReDim astrColumnWidths(0) For lngI = 1 To VBA.Len(strColumnWidths) Select Case VBA.Mid(strColumnWidths, lngI, 1) Case Is <> ";" astrColumnWidths(lngJ) = astrColumnWidths(lngJ) & VBA.Mid( _ strColumnWidths, lngI, 1) Case ";" lngJ = lngJ + 1 ReDim Preserve astrColumnWidths(lngJ) End Select Next lngI lngI = 0 strTemp = VBA.vbNullString Do Until lngI > UBound(astrColumnWidths) If Not IsNull(astrColumnWidths(lngI)) And astrColumnWidths(lngI) <> "" Then strTemp = strTemp & CSng(astrColumnWidths(lngI)) * sngFactor & ";" End If lngI = lngI + 1 Loop adjustColumnWidths = strTemp Erase astrColumnWidths Exit_adjustColumnWidths: On Error Resume Next Exit Function Err_adjustColumnWidths: Erase astrColumnWidths 'Destroy array. Resume Exit_adjustColumnWidths End Function 'الغرض من هذه الوظيفة اعادة حجم النموذج الى وضعه الطبيعي قبل اعادة التحجيم ويتم استدعاؤها عن تحميل النموذج Public Sub getOrigWindow(frm As Access.Form) On Error Resume Next OrigWindow.Height = frm.WindowHeight OrigWindow.Width = frm.WindowWidth End Sub 'الغرض من هذه الوظيفة هو اعادة مقاس النموذج الى وضعه الطبيعي عند حدث الاغلاق Public Sub RestoreWindow() On Error Resume Next Access.DoCmd.MoveSize , , OrigWindow.Width, OrigWindow.Height Access.DoCmd.Save End Sub هل فهمي لامر صحيح هكذا اخي 1 رابط هذا التعليق شارك More sharing options...
ابو عبد الرحمن اشرف قام بنشر مايو 20, 2023 الكاتب مشاركة قام بنشر مايو 20, 2023 10 ساعات مضت, ابو عبد الرحمن اشرف said: اخي الحبيب خليفة ما فهمته بناءا علي ما قرأته وهو اذا رغبت في وضع الكود الموضوع تحت زر الامر " اعادة التحجيم " في حدث عند الفتح او التحميل فلا يوجد مشكله . نضع هذا الحدث في النموذج عند الفتح On Error Resume Next ReSizeForm Me 'اعادة تحجيم النموذج الرئيسي ReSizeForm subForm.Form 'اعادة تحجيم النموذج الفرعي Me.cmdClose.SetFocus Me.cmdResize.Enabled = False ثم ننسخ الوحدة النمطية هذه الي قاعدة البيانات Option Compare Database Option Explicit 'قم بتغيير الارقام بناء على دقة الشاشة التي سوف تستخدمها للعرض مثلا 640 × 480 او 800 × 600 او 1024 × 768 بيكسل Private Const DESIGN_HORZRES As Long = 640 Private Const DESIGN_VERTRES As Long = 480 'مقدار عدد البكسلات في البوصة الواحده 96 يفضل تركه كما هو لانه قياسي Private Const DESIGN_PIXELS As Long = 96 Private Const WM_HORZRES As Long = 8 Private Const WM_VERTRES As Long = 10 Private Const WM_LOGPIXELSX As Long = 88 Private Const TITLEBAR_PIXELS As Long = 18 Private Const COMMANDBAR_PIXELS As Long = 26 Private Const COMMANDBAR_LEFT As Long = 0 Private Const COMMANDBAR_TOP As Long = 1 Private OrigWindow As tWindow Private Type tRect left As Long Top As Long right As Long bottom As Long End Type Private Type tDisplay Height As Long Width As Long DPI As Long End Type Private Type tWindow Height As Long Width As Long End Type Private Type tControl Name As String Height As Long Width As Long Top As Long left As Long End Type Private Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _ (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" _ () As Long Private Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" _ (ByVal hwnd As Long) As Long Private Declare Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" _ (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function WM_apiGetWindowRect Lib "user32.dll" Alias "GetWindowRect" _ (ByVal hwnd As Long, lpRect As tRect) As Long Private Declare Function WM_apiMoveWindow Lib "user32.dll" Alias "MoveWindow" _ (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _ ByVal nHeight As Long, ByVal bRepaint As Long) As Long Private Declare Function WM_apiIsZoomed Lib "user32.dll" Alias "IsZoomed" _ (ByVal hwnd As Long) As Long 'الغرض من هذه الوظيفة هو احضار معلومات الطول والعرض والبيكسل الحالي لشاشة العرض Private Function getScreenResolution() As tDisplay Dim hDCcaps As Long Dim lngRtn As Long On Error Resume Next hDCcaps = WM_apiGetDC(0) With getScreenResolution .Height = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES) .Width = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES) .DPI = WM_apiGetDeviceCaps(hDCcaps, WM_LOGPIXELSX) End With lngRtn = WM_apiReleaseDC(0, hDCcaps) End Function 'الغرض من هذه الوظيفة هو اعادة قيم عناصر النموذج كاملة في الطول والعرض وتكبيرها حسب مقاس الشاشة الحالية Private Function getFactor(blnVert As Boolean) As Single Dim sngFactorP As Single On Error Resume Next If getScreenResolution.DPI <> 0 Then sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI Else sngFactorP = 1 End If If blnVert Then getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP Else getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP End If End Function 'الغرض من هذه الوظيفة هي القيام بإستدعاءها في حدث عند الفتح وعند التحميل Public Sub ReSizeForm(ByVal frm As Access.Form) Dim rectWindow As tRect Dim lngWidth As Long Dim lngHeight As Long Dim sngVertFactor As Single Dim sngHorzFactor As Single Dim sngFontFactor As Single On Error Resume Next sngVertFactor = getFactor(True) sngHorzFactor = getFactor(False) sngFontFactor = VBA.IIf(sngHorzFactor < sngVertFactor, sngHorzFactor, sngVertFactor) Resize sngVertFactor, sngHorzFactor, sngFontFactor, frm If WM_apiIsZoomed(frm.hwnd) = 0 Then Access.DoCmd.RunCommand acCmdAppMaximize Call WM_apiGetWindowRect(frm.hwnd, rectWindow) With rectWindow lngWidth = .right - .left lngHeight = .bottom - .Top End With If frm.Parent.Name = VBA.vbNullString Then Call WM_apiMoveWindow(frm.hwnd, ((getScreenResolution.Width - _ (sngHorzFactor * lngWidth)) / 2) - getLeftOffset, _ ((getScreenResolution.Height - (sngVertFactor * lngHeight)) / 2) - _ getTopOffset, lngWidth * sngHorzFactor, lngHeight * sngVertFactor, 1) End If End If Set frm = Nothing End Sub 'الغرض من هذه الوظيفة هي اعادة تحجيم مقاسات الاقسام الخاصة بالنموذج مثل قسم تفصيل وقسم رأس النموذج وتذييل النموذج Private Sub Resize(sngVertFactor As Single, sngHorzFactor As Single, sngFontFactor As _ Single, ByVal frm As Access.Form) Dim ctl As Access.Control Dim arrCtls() As tControl Dim lngI As Long Dim lngJ As Long Dim lngWidth As Long Dim lngHeaderHeight As Long Dim lngDetailHeight As Long Dim lngFooterHeight As Long Dim blnHeaderVisible As Boolean Dim blnDetailVisible As Boolean Dim blnFooterVisible As Boolean Const FORM_MAX As Long = 31680 On Error Resume Next With frm .Painting = False lngWidth = .Width * sngHorzFactor lngHeaderHeight = .Section(Access.acHeader).Height * sngVertFactor lngDetailHeight = .Section(Access.acDetail).Height * sngVertFactor lngFooterHeight = .Section(Access.acFooter).Height * sngVertFactor .Width = FORM_MAX .Section(Access.acHeader).Height = FORM_MAX .Section(Access.acDetail).Height = FORM_MAX .Section(Access.acFooter).Height = FORM_MAX blnHeaderVisible = .Section(Access.acHeader).Visible blnDetailVisible = .Section(Access.acDetail).Visible blnFooterVisible = .Section(Access.acFooter).Visible .Section(Access.acHeader).Visible = False .Section(Access.acDetail).Visible = False .Section(Access.acFooter).Visible = False End With ReDim arrCtls(0) For Each ctl In frm.Controls If ((ctl.ControlType = Access.acTabCtl) Or _ (ctl.ControlType = Access.acOptionGroup)) Then With arrCtls(lngI) .Name = ctl.Name .Height = ctl.Height .Width = ctl.Width .Top = ctl.Top .left = ctl.left End With lngI = lngI + 1 ReDim Preserve arrCtls(lngI) End If Next ctl For Each ctl In frm.Controls If ctl.ControlType <> Access.acPage Then With ctl .Height = .Height * sngVertFactor .left = .left * sngHorzFactor .Top = .Top * sngVertFactor .Width = .Width * sngHorzFactor .FontSize = .FontSize * sngFontFactor Select Case .ControlType Case Access.acListBox .ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor) Case Access.acComboBox .ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor) .ListWidth = .ListWidth * sngHorzFactor Case Access.acTabCtl .TabFixedWidth = .TabFixedWidth * sngHorzFactor .TabFixedHeight = .TabFixedHeight * sngVertFactor End Select End With End If Next ctl For lngJ = 0 To lngI With frm.Controls.Item(arrCtls(lngJ).Name) .left = arrCtls(lngJ).left * sngHorzFactor .Top = arrCtls(lngJ).Top * sngVertFactor .Height = arrCtls(lngJ).Height * sngVertFactor .Width = arrCtls(lngJ).Width * sngHorzFactor End With Next lngJ With frm .Width = lngWidth .Section(Access.acHeader).Height = lngHeaderHeight .Section(Access.acDetail).Height = lngDetailHeight .Section(Access.acFooter).Height = lngFooterHeight .Section(Access.acHeader).Visible = blnHeaderVisible .Section(Access.acDetail).Visible = blnDetailVisible .Section(Access.acFooter).Visible = blnFooterVisible .Painting = True End With Erase arrCtls Set ctl = Nothing End Sub 'الغرض من هذه الوظيفة هو حساب مجموع البيكسل لكامل شاشة الاكسيس ناحية اليمين ووضع النموذج في منتصف الشاشة Private Function getTopOffset() As Long Dim cmdBar As Object Dim lngI As Long On Error GoTo err For Each cmdBar In Application.CommandBars If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_TOP)) Then lngI = lngI + 1 End If Next cmdBar getTopOffset = (TITLEBAR_PIXELS + (lngI * COMMANDBAR_PIXELS)) exit_fun: Exit Function err: getTopOffset = TITLEBAR_PIXELS + COMMANDBAR_PIXELS Resume exit_fun End Function 'الغرض من هذه الوظيفة هو حساب مجموع البيكسل لكامل شاشة الاكسيس ناحية اليسار ووضع النموذج في منتصف الشاشة Private Function getLeftOffset() As Long Dim cmdBar As Object Dim lngI As Long On Error GoTo err For Each cmdBar In Application.CommandBars If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_LEFT)) Then lngI = lngI + 1 End If Next cmdBar getLeftOffset = (lngI * COMMANDBAR_PIXELS) exit_fun: Exit Function err: getLeftOffset = 0 Resume exit_fun End Function 'الغرض من هذه الوظيفة هو اعادة تحجيم كامل عرض الاعمدة وعدم ترك فراغات من الناحية اليسرى Private Function adjustColumnWidths(strColumnWidths As String, sngFactor As Single) As String On Error GoTo Err_adjustColumnWidths Dim astrColumnWidths() As String Dim strTemp As String Dim lngI As Long Dim lngJ As Long ReDim astrColumnWidths(0) For lngI = 1 To VBA.Len(strColumnWidths) Select Case VBA.Mid(strColumnWidths, lngI, 1) Case Is <> ";" astrColumnWidths(lngJ) = astrColumnWidths(lngJ) & VBA.Mid( _ strColumnWidths, lngI, 1) Case ";" lngJ = lngJ + 1 ReDim Preserve astrColumnWidths(lngJ) End Select Next lngI lngI = 0 strTemp = VBA.vbNullString Do Until lngI > UBound(astrColumnWidths) If Not IsNull(astrColumnWidths(lngI)) And astrColumnWidths(lngI) <> "" Then strTemp = strTemp & CSng(astrColumnWidths(lngI)) * sngFactor & ";" End If lngI = lngI + 1 Loop adjustColumnWidths = strTemp Erase astrColumnWidths Exit_adjustColumnWidths: On Error Resume Next Exit Function Err_adjustColumnWidths: Erase astrColumnWidths 'Destroy array. Resume Exit_adjustColumnWidths End Function 'الغرض من هذه الوظيفة اعادة حجم النموذج الى وضعه الطبيعي قبل اعادة التحجيم ويتم استدعاؤها عن تحميل النموذج Public Sub getOrigWindow(frm As Access.Form) On Error Resume Next OrigWindow.Height = frm.WindowHeight OrigWindow.Width = frm.WindowWidth End Sub 'الغرض من هذه الوظيفة هو اعادة مقاس النموذج الى وضعه الطبيعي عند حدث الاغلاق Public Sub RestoreWindow() On Error Resume Next Access.DoCmd.MoveSize , , OrigWindow.Width, OrigWindow.Height Access.DoCmd.Save End Sub هل فهمي لامر صحيح هكذا اخي اخي خليفة وضعت الكود السابق ولم يفلح فوضعت هذا الكود اخي Dim sngFactorP As Single On Error Resume Next If getScreenResolution.DPI <> 0 Then sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI Else sngFactorP = 1 End If If blnVert Then getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP Else getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP End If هل هذا صحيح رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان