ابو تميم قام بنشر أكتوبر 31, 2012 قام بنشر أكتوبر 31, 2012 تحية طيبة لجميع أعضاء منتدى أوفيسنا الكرام حاولت ضبط ملف الاكسل بحسب دقة عرض معينة بحيث يتناسب العرض مع شاشة جهازي وبحيث تظهر عندي جميع الأعمدة التي فيها بيانات وأستخدمها للعمل ولكن عند نقل ملف الاكسل إلى جهاز آخر فإن دقة عرض الشاشة تختلف إما أن تكون الدقة أكبر من دقة عرض جهازي ( وهنا لا يتأثر الملف وتظهر جميع الأعمدة التي يتم العمل عليها ) ولكن المشكلة عندما أضع الملف على جهاز فيه دقة عرض الشاشة أقل من دقة عرض جهازي فإن الملف هنا يعمل ويكون عرض البيانات فيه بشكل كبير وغير ملائم للعمل بحيث لا تظهر جميع الاعمدة التي يتم العمل عليها وهنا أنت بحاجة إلى الانتقال إلى الأعمدة الغير ظاهرة بشريط التمرير الأفقي أو أن تنتقل عبر الخلايا إلى اليمين بالأسهم وهكذا السؤال هنا هل يمكننا بواسطة كود ضبط دقة عرض الملف الاكسل بما يتناسب مع الأعمدة التي تحتوي على بيانات بحيث إذا كانت دقة عرض الشاشة التي يتم العرض عليها أقل من دقة العرض 1280×960 يتم ضبط عرض ملف الاكسل بحيث يتناسب في عرض البيانات على الشاشة الجديدة وأن يتم تغيير دقة عرض البيانات في ملف الاكسل بشكل تلقائي بما يتناسب مع دقة عرض الشاشة التي يعرض عليها والهدف من ذلك هو ظهور جميع الأعمدة التي تحتوي على بيانات وجزاكم الله خيرا
الـعيدروس قام بنشر أكتوبر 31, 2012 قام بنشر أكتوبر 31, 2012 (معدل) السلام عليكم جرب هذا الكود هذا في حدث 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 بواسطه عباد
ابو تميم قام بنشر أكتوبر 31, 2012 الكاتب قام بنشر أكتوبر 31, 2012 أخي ابو نصار شكرا لك قمت بتجربة الكود في ملف عادي وأعطاني الرسالة ولكنه لم يقوم بتغيير دقة الشاشة ولم يقم بتغيير دقة عرض ملف الاكسل وبقي كل شيء كما هو ولم يتغير أي شيء هل هناك مشكلة ما
احمدزمان قام بنشر نوفمبر 16, 2012 قام بنشر نوفمبر 16, 2012 السلام عليكم و رحمة الله وبركاته بعد اذن اخي ابو نصار الذي لا يشق له غبار في الأكواد هذا كود آخر يقوم بتكبير العرض ZOOM للورقة الحالية Range("a1:g1").select Activewindow.Zoom = true اذا افترضنا انك تريد تكبير العرض لكي يشمل فقط الأعمدة من A الى G ضع هذا الكود في موديل واربطه مع زر في نفس الورقة 2
عبدالله باقشير قام بنشر نوفمبر 17, 2012 قام بنشر نوفمبر 17, 2012 السلام عليكم و رحمة الله وبركاته بعد اذن اخي ابو نصار الذي لا يشق له غبار في الأكواد هذا كود آخر يقوم بتكبير العرض ZOOM للورقة الحالية Range("a1:g1").select Activewindow.Zoom = true اذا افترضنا انك تريد تكبير العرض لكي يشمل فقط الأعمدة من A الى G ضع هذا الكود في موديل واربطه مع زر في نفس الورقة احسنت اخي احمد كود ذكي جدا جزاك الله خيرا والشكر واصل للاخ ابو انصار تقبلوا تحياتي وشكري
ابو تميم قام بنشر نوفمبر 17, 2012 الكاتب قام بنشر نوفمبر 17, 2012 الأستاذ احمد زمان جزاك الله خيرا كود رهيب وذكي جدا ولكن هل يمكننا التعديل أكثر حيث أن هذا الكود يعمل على تكبير الورقة الحالية بحسب عرض الشاشة وذلك يؤثر على الناحية الجمالية للملف وأنا أريد أن يتم تغيير حجم ودقة العرض فقط للأجهزة ذات دقة العرض المنخفضة التي تقل عن 1024× 768 بحيث يتم تصغير حجم دقة عرض الملف ليتناسب مع هذه الشاشة أما الشاشات التي تزيد دقة عرضعا عن الدقة 1024× 768 فيبقى الملف كما هو دون تأثير لأن هذه الدقة أصلا الملف يظهر عليها بشكل واضح أما الشاشات التي دقتها أقل من ذلك بعض الأعمدة لا تظهر فيها لأن دقة العرض فيها قليلة شكرا وجزاكم الله خيرا
احمدزمان قام بنشر نوفمبر 17, 2012 قام بنشر نوفمبر 17, 2012 السلام عليكم و رحمة الله وبركاته بعد اذن اخي ابو نصار الذي لا يشق له غبار في الأكواد هذا كود آخر يقوم بتكبير العرض ZOOM للورقة الحالية Range("a1:g1").select Activewindow.Zoom = true اذا افترضنا انك تريد تكبير العرض لكي يشمل فقط الأعمدة من A الى G ضع هذا الكود في موديل واربطه مع زر في نفس الورقة احسنت اخي احمد كود ذكي جدا جزاك الله خيرا والشكر واصل للاخ ابو انصار تقبلوا تحياتي وشكري وعليكم السلام و رحمة الله وبركاته استاذنا الكبير جدا بمقامة جزاك الله كل خير على هذا المرور الجميل وشهادتك تاج لي و لـ ابونصار نضعها تاج على رؤسنا ونفتخر بها خالص تحياتي وتقديري لكم ولا ننسى فضلكم ابدا
basem said قام بنشر نوفمبر 17, 2012 قام بنشر نوفمبر 17, 2012 هذا الملف يحول اى دقة موجوده الى 1024 اتمنى ان يفى بالغرض 1.rar
خالد الشاعر قام بنشر نوفمبر 18, 2012 قام بنشر نوفمبر 18, 2012 استاذ باسم سعيد الف شكر تسلم ايدك جزاك الله كل خير
ابو تميم قام بنشر نوفمبر 18, 2012 الكاتب قام بنشر نوفمبر 18, 2012 شكرا أخي باسم على الملف ولكن لدي تعليق بسيط على ذلك أولا : أنت وضعت كلمة مرور على الملف لذلك لا يمكننا رؤية الكود وتعديله إلا بعد فك حماية الملف ومن لا يملك طريقة لفك الحماية فإنة لا يستفيد من الكود وهذا المنتدى يعمل تحت بيئة التعاون ونشر العلم ثانيا : الملف يقوم بتغيير دقة عرض الشاشة نفسها وهذا مغاير للمطلوب في السؤال فسؤالي هو تغيير دقة عرض الملف ليتناسب من دقة عرض الشاشة أي طلبي بالعكس وهو توافق الملف مع إعدادات الجهاز وليس توافق الجهاز مع ضبط الملف شكرا على تعاونك وجزاكم الله خيرا ولتعم الفائدة الكود الذي قدمه الأخ باسم هو 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
basem said قام بنشر نوفمبر 18, 2012 قام بنشر نوفمبر 18, 2012 استاذ ابو تميم للاسف انا نسيت احذف كلمة السر ليس الا وليس لغرض اخر وشكرا لاهتمامك
محمود_الشريف قام بنشر يناير 3, 2014 قام بنشر يناير 3, 2014 موضوع فى غاية الأهمية وأكواد أكثر من رائعة من أساتذة يستحقوا أكثر من الشكر ولا أملك إلا الدعاء لهم بخير الخير نسأل الله عز وجل أن يحفظكم جميعا ويزيدكم من فضله ومتابع عن كثب لهذا الموضوع المفيد بحق
maxstreets قام بنشر يناير 8, 2019 قام بنشر يناير 8, 2019 الموضوع مهم أخواني ولم أجد الحل المنطقي لذلك ...ز.
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.