ضبط دقة عرض ملف الاكسل بحسب دقة عرض الشاشة

[ابو تميم]

تحية طيبة لجميع أعضاء منتدى أوفيسنا الكرام

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

ولكن عند نقل ملف الاكسل إلى جهاز آخر فإن دقة عرض الشاشة تختلف إما أن تكون الدقة أكبر من دقة عرض جهازي ( وهنا لا يتأثر الملف وتظهر جميع الأعمدة التي يتم العمل عليها )

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

السؤال هنا

هل يمكننا بواسطة كود ضبط دقة عرض الملف الاكسل بما يتناسب مع الأعمدة التي تحتوي على بيانات بحيث إذا كانت دقة عرض الشاشة التي يتم العرض عليها أقل من دقة العرض 1280×960 يتم ضبط عرض ملف الاكسل بحيث يتناسب في عرض البيانات على الشاشة الجديدة وأن يتم تغيير دقة عرض البيانات في ملف الاكسل بشكل تلقائي بما يتناسب مع دقة عرض الشاشة التي يعرض عليها

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

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

[الـعيدروس]

السلام عليكم

جرب هذا الكود

هذا في حدث Thisworkbook

Option Explicit

Dim vidwidth As Integer

Dim vidheight As Integer

Dim Msg

Dim ans

Dim msg1

Private Sub Workbook_Open()

If Left(Application.Version, 1) = 5 Then

' 16-bit Excel

  vidwidth = GetSystemMetrics16(SM_CXSCREEN)

  vidheight = GetSystemMetrics16(SM_CYSCREEN)

Else

' 32-bit Excel

  vidwidth = GetSystemMetrics(SM_CXSCREEN)

  vidheight = GetSystemMetrics(SM_CYSCREEN)

  If vidwidth = 1024 And vidheight = 960 Then

    Exit Sub

	 Else

Msg = "دقة الشاشة الحالية: "

    msg1 = Msg & vidwidth & "x" & vidheight

    Msg = msg1 & vbCr & vbLf & "هذا التطبيق يحتاج إلى دقة أعلى ليعمل بشكل صحيح." _

    & vbLf & "هل ترغب في تغيير الوضع إلى 1024x768 الآن؟"

  ans = MsgBox(Msg, vbYesNo, "تغيير دقة الشاشة؟")

If ans = vbYes Then

' وضع الشاشة الذي تريده العرض والطول واللون

ChangeScreenSettings 1024, 960, 32, 75

Else

End If

End If

End If

End Sub

وهذا الكود في مودويل

Public Const CCDEVICENAME = 32

Public Const CCFORMNAME = 32

Public Const DISP_CHANGE_SUCCESSFUL = 0

Public Const DISP_CHANGE_RESTART = 1

Public Const DISP_CHANGE_FAILED = -1

Public Const DISP_CHANGE_BADMODE = -2

Public Const DISP_CHANGE_NOTUPDATED = -3

Public Const DISP_CHANGE_BADFLAGS = -4

Public Const DISP_CHANGE_BADPARAM = -5

Public Const CDS_UPDATEREGISTRY = &H1

Public Const CDS_TEST = &H2

Public Const DM_BITSPERPEL = &H40000

Public Const DM_PELSWIDTH = &H80000

Public Const DM_PELSHEIGHT = &H100000

Public Type DEVMODE

dmDeviceName As String * CCDEVICENAME

dmSpecVersion As Integer

dmDriverVersion As Integer

dmSize As Integer

dmDriverExtra As Integer

dmFields As Long

dmOrientation As Integer

dmPaperSize As Integer

dmPaperLength As Integer

dmPaperWidth As Integer

dmScale As Integer

dmCopies As Integer

dmDefaultSource As Integer

dmPrintQuality As Integer

dmColor As Integer

dmDuplex As Integer

dmYResolution As Integer

dmTTOption As Integer

dmCollate As Integer

dmFormName As String * CCFORMNAME

dmUnusedPadding As Integer

dmBitsPerPel As Integer

dmPelsWidth As Long

dmPelsHeight As Long

dmDisplayFlags As Long

dmDisplayFrequency As Long

End Type

Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long

Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Declare Function GetSystemMetrics16 Lib "user" Alias "GetSystemMetrics" (ByVal nIndex As Integer) As Integer

Public Const SM_CXSCREEN = 0

Public Const SM_CYSCREEN = 1

Public Sub ChangeScreenSettings(lWidth As Integer, lHeight As Integer, lColors As Integer, lfrequency As Integer)

Dim tDevMode As DEVMODE, lTemp As Long, lIndex As Long

lIndex = 0

Do

lTemp = EnumDisplaySettings(0&, lIndex, tDevMode)

If lTemp = 0 Then Exit Do

lIndex = lIndex + 1

With tDevMode

If .dmPelsWidth = lWidth And .dmPelsHeight = lHeight _

And .dmBitsPerPel = lColors And .dmDisplayFrequency = lfrequency Then

lTemp = ChangeDisplaySettings(tDevMode, CDS_UPDATEREGISTRY)

Exit Do

End If

End With

Loop

Select Case lTemp

Case DISP_CHANGE_SUCCESSFUL

Case DISP_CHANGE_RESTART

MsgBox "يجب إعادة تشغيل الكمبيوتر من أجل تعديل دقة الشاشة", vbQuestion

Case DISP_CHANGE_FAILED

MsgBox "فشل برنامج تشغيل العرض لوضع الرسومات المحدد", vbCritical

Case DISP_CHANGE_BADMODE

MsgBox "غير معتمد وضع الرسومات", vbCritical

Case DISP_CHANGE_NOTUPDATED

MsgBox "غير قادر على الكتابة في إعدادات التسجيل", vbCritical

Case DISP_CHANGE_BADFLAGS

MsgBox "تجاوزت بيانات غير صالحة", vbCritical

End Select

End Sub

تم تعديل أكتوبر 31, 2012 بواسطه عباد

[ابو تميم]

أخي ابو نصار شكرا لك

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

هل هناك مشكلة ما

[ابو تميم]

up

[ابو تميم]

up

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

بعد اذن اخي ابو نصار الذي لا يشق له غبار في الأكواد

هذا كود آخر يقوم بتكبير العرض ZOOM للورقة الحالية

Range("a1:g1").select

Activewindow.Zoom = true

اذا افترضنا انك تريد تكبير العرض لكي يشمل فقط الأعمدة من A الى G

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

[عبدالله باقشير]

السلام عليكم و رحمة الله وبركاته

بعد اذن اخي ابو نصار الذي لا يشق له غبار في الأكواد

هذا كود آخر يقوم بتكبير العرض ZOOM للورقة الحالية

Range("a1:g1").select

Activewindow.Zoom = true

اذا افترضنا انك تريد تكبير العرض لكي يشمل فقط الأعمدة من A الى G

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

احسنت اخي احمد

كود ذكي جدا

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

والشكر واصل للاخ ابو انصار

تقبلوا تحياتي وشكري

[ابو تميم]

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

كود رهيب وذكي جدا

ولكن هل يمكننا التعديل أكثر حيث أن هذا الكود يعمل على تكبير الورقة الحالية بحسب عرض الشاشة وذلك يؤثر على الناحية الجمالية للملف

وأنا أريد أن يتم تغيير حجم ودقة العرض فقط للأجهزة ذات دقة العرض المنخفضة التي تقل عن 1024× 768 بحيث يتم تصغير حجم دقة عرض الملف ليتناسب مع هذه الشاشة

أما الشاشات التي تزيد دقة عرضعا عن الدقة 1024× 768 فيبقى الملف كما هو دون تأثير لأن هذه الدقة أصلا الملف يظهر عليها بشكل واضح أما الشاشات التي دقتها أقل من ذلك بعض الأعمدة لا تظهر فيها لأن دقة العرض فيها قليلة

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

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

بعد اذن اخي ابو نصار الذي لا يشق له غبار في الأكواد

هذا كود آخر يقوم بتكبير العرض ZOOM للورقة الحالية

Range("a1:g1").select

Activewindow.Zoom = true

اذا افترضنا انك تريد تكبير العرض لكي يشمل فقط الأعمدة من A الى G

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

احسنت اخي احمد

كود ذكي جدا

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

والشكر واصل للاخ ابو انصار

تقبلوا تحياتي وشكري

وعليكم السلام و رحمة الله وبركاته

استاذنا الكبير جدا بمقامة

جزاك الله كل خير على هذا المرور الجميل

وشهادتك تاج لي و لـ ابونصار نضعها تاج على رؤسنا ونفتخر بها

خالص تحياتي وتقديري لكم ولا ننسى فضلكم ابدا

[basem said]

هذا الملف يحول اى دقة موجوده الى 1024

اتمنى ان يفى بالغرض

1.rar

[خالد الشاعر]

استاذ باسم سعيد

الف شكر تسلم ايدك

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

[ابو تميم]

شكرا أخي باسم على الملف

ولكن لدي تعليق بسيط على ذلك

أولا : أنت وضعت كلمة مرور على الملف لذلك لا يمكننا رؤية الكود وتعديله إلا بعد فك حماية الملف ومن لا يملك طريقة لفك الحماية فإنة لا يستفيد من الكود وهذا المنتدى يعمل تحت بيئة التعاون ونشر العلم

ثانيا : الملف يقوم بتغيير دقة عرض الشاشة نفسها وهذا مغاير للمطلوب في السؤال فسؤالي هو تغيير دقة عرض الملف ليتناسب من دقة عرض الشاشة

أي طلبي بالعكس وهو توافق الملف مع إعدادات الجهاز وليس توافق الجهاز مع ضبط الملف

شكرا على تعاونك وجزاكم الله خيرا

ولتعم الفائدة الكود الذي قدمه الأخ باسم هو

Public Const EWX_LOGOFF = 0

Public Const EWX_SHUTDOWN = 1

Public Const EWX_REBOOT = 2

Public Const EWX_FORCE = 4

Public Const CCDEVICENAME = 32

Public Const CCFORMNAME = 32

Public Const DM_BITSPERPEL = &H40000

Public Const DM_PELSWIDTH = &H80000

Public Const DM_PELSHEIGHT = &H100000

Public Const CDS_UPDATEREGISTRY = &H1

Public Const CDS_TEST = &H4

Public Const DISP_CHANGE_SUCCESSFUL = 0

Public Const DISP_CHANGE_RESTART = 1


Type typDevMODE

dmDeviceName As String * CCDEVICENAME

dmSpecVersion As Integer

dmDriverVersion As Integer

dmSize As Integer

dmDriverExtra As Integer

dmFields As Long

dmOrientation As Integer

dmPaperSize As Integer

dmPaperLength As Integer

dmPaperWidth As Integer

dmScale As Integer

dmCopies As Integer

dmDefaultSource As Integer

dmPrintQuality As Integer

dmColor As Integer

dmDuplex As Integer

dmYResolution As Integer

dmTTOption As Integer

dmCollate As Integer

dmFormName As String * CCFORMNAME

dmUnusedPadding As Integer

dmBitsPerPel As Integer

dmPelsWidth As Long

dmPelsHeight As Long

dmDisplayFlags As Long

dmDisplayFrequency As Long

End Type


Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lptypDevMode As Any) As Boolean

Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lptypDevMode As Any, ByVal dwFlags As Long) As Long

Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long


Sub aaa()

Dim typDevM As typDevMODE

Dim lngResult As Long

Dim intAns As Integer


lngResult = EnumDisplaySettings(0, 0, typDevM)


With typDevM

.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

.dmPelsWidth = 1366 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)

.dmPelsHeight = 768 'ÇÎÊÑ ÇáØæá (480,600,768, etc)

End With


lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)

Select Case lngResult

Case DISP_CHANGE_RESTART

intAns = MsgBox("You must restart your computer to apply these changes." & _

vbCrLf & vbCrLf & "Do you want to restart now?", _

vbYesNo + vbSystemModal, "Screen Resolution")

If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)

Case DISP_CHANGE_SUCCESSFUL

Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)


Case Else

MsgBox "Mode not supported", vbSystemModal, "Error"

End Select

End Sub


Sub bbb()

Dim typDevM As typDevMODE

Dim lngResult As Long

Dim intAns As Integer


lngResult = EnumDisplaySettings(0, 0, typDevM)


With typDevM

.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

.dmPelsWidth = 1024 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)

.dmPelsHeight = 768 'ÇÎÊÑ ÇáØæá (480,600,768, etc)

End With


lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)

Select Case lngResult

Case DISP_CHANGE_RESTART

intAns = MsgBox("You must restart your computer to apply these changes." & _

vbCrLf & vbCrLf & "Do you want to restart now?", _

vbYesNo + vbSystemModal, "Screen Resolution")

If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)

Case DISP_CHANGE_SUCCESSFUL

Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)


Case Else

MsgBox "Mode not supported", vbSystemModal, "Error"

End Select

End Sub

[احمد فضيله]

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

[ابو تميم]

up

[basem said]

استاذ ابو تميم

للاسف انا نسيت احذف كلمة السر ليس الا وليس لغرض اخر

وشكرا لاهتمامك

[وليد فتحي]

لاثراء الموضوع مرة أخري

[وليد فتحي]

وان شاء الله ابو تميم ونحن نجد المطلوب

[منياوى]

شكراً

[محمود_الشريف]

موضوع فى غاية الأهمية

وأكواد أكثر من رائعة من أساتذة يستحقوا أكثر من الشكر

ولا أملك إلا الدعاء لهم بخير الخير

نسأل الله عز وجل أن يحفظكم جميعا ويزيدكم من فضله

ومتابع عن كثب لهذا الموضوع المفيد بحق 

[maxstreets]

الموضوع مهم أخواني ولم أجد الحل  المنطقي لذلك ...ز.