اذهب الي المحتوي
أوفيسنا

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


Smart man

الردود الموصى بها

53 دقائق مضت, Smart man said:

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

ضع الكود الاتى فى مديول 

Private Type RECT
    X1 As Long
    Y1 As Long
    X2 As Long
    Y2 As Long
End Type
#If VBA7 Then
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, Rectangle As RECT) As Boolean
    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If
Private Const WU_LOGPIXELSX = 88
Private Const WU_LOGPIXELSY = 90

Sub CenterForm(f As Form)
    Dim formWidth As Long, formHeight As Long
    Dim MaxWidth As Long, maxHeight As Long
    Dim ScreenWidth As Long, ScreenHeight As Long
    Dim formAllMarginsHeight As Long, formAllMarginsWidth As Long

    GetScreenResolution ScreenWidth, ScreenHeight
    ScreenWidth = ConvertPixelsToTwips(ScreenWidth, 0)
    ScreenHeight = ConvertPixelsToTwips(ScreenHeight, 0)
    MaxWidth = ScreenWidth * 0.6
    maxHeight = ScreenHeight * 0.9

    formAllMarginsHeight = f.WindowHeight - f.Section(acDetail).Height
    formAllMarginsWidth = f.Width

    formWidth = formAllMarginsWidth
    formHeight = formAllMarginsHeight
    
    If formHeight < f.WindowHeight Then
        formHeight = f.WindowHeight
    End If
    DoCmd.MoveSize (ScreenWidth - formWidth) / 2, (ScreenHeight - formHeight) / 2, formWidth, formHeight

End Sub

Sub CenterReport(R As Report)
    Dim ReportWidth As Long, ReportHeight As Long
    Dim MaxWidth As Long, maxHeight As Long
    Dim ScreenWidth As Long, ScreenHeight As Long
    Dim ReportAllMarginsHeight As Long, ReportAllMarginsWidth As Long

    GetScreenResolution ScreenWidth, ScreenHeight
    ScreenWidth = ConvertPixelsToTwips(ScreenWidth, 0)
    ScreenHeight = ConvertPixelsToTwips(ScreenHeight, 0)
    MaxWidth = ScreenWidth * 0.6
    maxHeight = ScreenHeight * 0.9

    ReportAllMarginsHeight = R.WindowHeight - R.Section(acDetail).Height
    ReportAllMarginsWidth = R.Width

    ReportWidth = ReportAllMarginsWidth
    ReportHeight = ReportAllMarginsHeight
    
    If ReportHeight < R.WindowHeight Then
        ReportHeight = R.WindowHeight
    End If
    DoCmd.MoveSize (ScreenWidth - ReportWidth) / 2, (ScreenHeight - ReportHeight) / 2, ReportWidth, ReportHeight
End Sub

Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long
    Dim lngPixelsPerInch As Long
    Const nTwipsPerInch = 1440

#If VBA7 Then
    Dim lngDC As LongPtr
#Else
    Dim lngDC As Long
#End If
    
    lngDC = GetDC(0)
    If (lngDirection = 0) Then
        lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
    Else
        lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
    End If
    lngDC = ReleaseDC(0, lngDC)
    ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch
End Function

Function ConvertPixelsToTwips(lngPixels As Long, lngDirection As Long) As Long
    Dim lngPixelsPerInch As Long
    Const nTwipsPerInch = 1440
    
#If VBA7 Then
    Dim lngDC As LongPtr
#Else
    Dim lngDC As Long
#End If
    
    lngDC = GetDC(0)

    If (lngDirection = 0) Then
        lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
    Else
        lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
    End If
    lngDC = ReleaseDC(0, lngDC)
    ConvertPixelsToTwips = (lngPixels * nTwipsPerInch) / lngPixelsPerInch
End Function

Private Sub GetScreenResolution(ByRef Width As Long, ByRef Height As Long)
    Dim R As RECT
    Dim RetVal As Long

#If VBA7 Then
    Dim hWnd As LongPtr
#Else
    Dim hWnd As Long
#End If
    hWnd = GetDesktopWindow()
    RetVal = GetWindowRect(hWnd, R)
    Width = R.X2 - R.X1
    Height = R.Y2 - R.Y1
End Sub

ويتم وضع الكود الاتى فى حدث عند فتح النموذج

    Call CenterForm(Me)

 

ويتم وضع الكود الاتى فى حدث عند فتح التقرير

    Call CenterReport(Me)

 

تم تعديل بواسطه ابا جودى
  • Like 1
رابط هذا التعليق
شارك

16 دقائق مضت, احمد الفلاحجي said:

جزاك الله خيرا اخى محمد

هل اطمع بمثال منك اخى العالى

بالتوفيق اخى

حزانا الله واياكم وكل أساتذتنا خير الجزاء

اتفضل تحت امرك :fff:

 

AutoCentre.mdb

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

1 دقيقه مضت, abouelhassan said:

ممكن سؤال بعد التطبيق بنجاح وبعد اخفاء اطار الاكسيس التقرير لايفتح بالرغم من ان خاصية POP UP YES وخاصية MODAL YES

ممكن اعرف السبب اخى فى الله مشكور

ممكن مرفق

  • Like 1
رابط هذا التعليق
شارك

ها هو اخى بارك الله فيك

الفورم الدخول مستخدم حسان باس ورد123

التقرير الذى لايفتح هو بالفورم MAIN اسمه تقرير مهم جدااا يجب الدخول بفورم لوج اين اليوزر والباس بالاعلى استاذنا

هو التقرير الوحيد الذى لايفتح 

بارك الله فيك

DATA200027.mdb.rar

رابط هذا التعليق
شارك

2 ساعات مضت, abouelhassan said:

ها هو اخى بارك الله فيك

الفورم الدخول مستخدم حسان باس ورد123

التقرير الذى لايفتح هو بالفورم MAIN اسمه تقرير مهم جدااا يجب الدخول بفورم لوج اين اليوزر والباس بالاعلى استاذنا

هو التقرير الوحيد الذى لايفتح 

بارك الله فيك

DATA200027.mdb.rar 265.76 kB · 2 downloads

aaa.jpg.91bfae7b3c3fe4760452e78409708c50.jpg

اجعلها نعم كما في الصورة 

  • Like 1
رابط هذا التعليق
شارك

11 ساعات مضت, Smart man said:

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

اخي الفاضل ،

انت عملت هذا الموضوع ، وموضوع: فتح تطبيق الاكسيس بحجم صغير accmdappsize - قسم الأكسيس Access - أوفيسنا (officena.net)

وبدل ان تشارك فيهما ، واذا بك تضع نفس المشاركة في موضوع آخر لا علاقة له بطلبك !!

 

رجاء متابعة موضوعك مع الاعضاء هنا ، والاستفسار عن اي شيء يواجهك 🙂

 

جعفر

رابط هذا التعليق
شارك

في ٢٤‏/٥‏/٢٠٢١ at 23:21, abouelhassan said:

بارك الله فيك استاذى د.كاف يار

تم التغير ولا زال التقرير لا يظهر بارك الله فيك اخى الكريم وزادك الله من فضله

احترامى

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

DoCmd.Maximize

 

امام بخصوص مرفقكم استاذى الكريم على وجه الخصوص فان زر الامر المكتوب عليه تقرير مهم جدا هو يفتح تقرير باسم rpt_Items_Pages_3

ان قمت بفتحه فى وضع التصميم تجد الاتى كائنات بها خطأ فى مصدر البيانات الخاص بها

 

ثانيا لى تعقيب صعير على الكود المستخدم فى اخعاء الاطار لا يظهر على شريط المهام وبالتالى ان حدثت مشكلة فى الاكسس اثناء العمل والجهاز هنج يغلق ملف القاعدة ولكن يبقى معلق بالذاكرة وان حاولت فنح التطبيق لن يفتح

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

 

 

112211.jpg

  • Like 1
رابط هذا التعليق
شارك

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

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


DoCmd.Maximize

 

امام بخصوص مرفقكم استاذى الكريم على وجه الخصوص فان زر الامر المكتوب عليه تقرير مهم جدا هو يفتح تقرير باسم rpt_Items_Pages_3

ان قمت بفتحه فى وضع التصميم تجد الاتى كائنات بها خطأ فى مصدر البيانات الخاص بها

 

ثانيا لى تعقيب صعير على الكود المستخدم فى اخعاء الاطار لا يظهر على شريط المهام وبالتالى ان حدثت مشكلة فى الاكسس اثناء العمل والجهاز هنج يغلق ملف القاعدة ولكن يبقى معلق بالذاكرة وان حاولت فنح التطبيق لن يفتح

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

 

 

112211.jpg

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

 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information