البحث في الموقع

لدي الملف المرفق أدناه وهو عبارة عن (يوزرفورم) أول ما تفتح الملف يظهر اليوزرفورم ويختفي الاكسل وبعد الضغط على أحد الازرار في اليوزرفورم يفتح الاكسل ويختفي اليوزرفورم المشكلة .. عند اغلاق شيت الاكسل أرغب بأن يظهر اليوزرفورم من جديد (حتى أتمكن من مواصلة العمل عليه) ولا أرغب بأن يغلق البرنامج وأضطر لفتحه من جديد .. كيف استطيع أن أفعل ذلك ارجوا المساعدة .. ولكم جزيل الشكر رصد.xlsm

كان (الأستاذ أبو عبد الملك السوفي) طلب كود لجعل ال Frame شفافاً ففكرت بشرح الموضوع والأكواد كلها وكيفية وضعها من خلال ثلاث حالات الحالة الأولى :- لجعل frame شفافاً ليعطى شكل صفحة الإكسل التى خلفه تقوم بعمل Class Modules ومن الخصائص تقوم بتغيير اسمه إلى CTransparentFrameMaker ونقوم بوضع هذا الكود به Option Explicit Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type PICTDESC Size As Long Type As Long #If VBA7 Then hPic As LongPtr #Else hPic As Long #End If hPal As Long End Type #If VBA7 Then 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long Private hMemDc As LongPtr #Else 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private hMemDc As Long #End If Private Const SRCCOPY = &HCC0020 Private Const PICTYPE_BITMAP = &H1 Private Const SM_CYFRAME = 33 Private Const HORZ = 8 Private Const VERT = 10 Private arFramesArray() As Control Private i As Long Private WithEvents oForm As UserForm Private Sub Class_Initialize() i = -1 VBA.AppActivate Application.Caption Call TakeFirstScreenSnapShot End Sub Private Sub Class_Terminate() DeleteDC hMemDc End Sub Public Sub AddFrame(ByVal Frame As Control) i = i + 1 ReDim Preserve arFramesArray(i) Set arFramesArray(i) = Frame Set oForm = Frame.Parent End Sub Private Sub UpdateFrameBackGround(ByVal frm As Control) #If VBA7 Then Dim hMemDc2 As LongPtr, hMemBmp2 As LongPtr #Else Dim hMemDc2 As Long, hMemBmp2 As Long #End If Dim tFrameRect As RECT Dim oPic As IPicture On Error Resume Next GetWindowRect frm.[_GethWnd], tFrameRect With tFrameRect hMemDc2 = CreateCompatibleDC(hMemDc) hMemBmp2 = CreateCompatibleBitmap(hMemDc, .Right - .Left, .Bottom - .Top) SelectObject hMemDc2, hMemBmp2 BitBlt hMemDc2, 0, 0, .Right - .Left, .Bottom - .Top, hMemDc, .Left, .Top + GetSystemMetrics(SM_CYFRAME), SRCCOPY End With Set oPic = CreatePic(hMemBmp2) SavePicture oPic, Environ("Temp") & "\" & frm.Name & ".bmp" Set frm.Picture = LoadPicture(Environ("Temp") & "\" & frm.Name & ".bmp") Kill Environ("Temp") & "\" & frm.Name & ".bmp" DeleteObject hMemBmp2 DeleteDC hMemDc2 End Sub #If VBA7 Then Private Function CreatePic(ByVal hbmp As LongPtr) As IPicture #Else Private Function CreatePic(ByVal hbmp As Long) As IPicture #End If Dim IID_IDispatch As GUID Dim uPicinfo As PICTDESC Dim IPic As IPicture With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With With uPicinfo .Size = Len(uPicinfo) ' .Type = PICTYPE_BITMAP .hPic = hbmp .hPal = 0 End With OleCreatePictureIndirect uPicinfo, IID_IDispatch, 1, IPic Set CreatePic = IPic End Function Private Sub TakeFirstScreenSnapShot() #If VBA7 Then Dim scrDc As LongPtr, hMemBmp As LongPtr, hwnd As LongPtr #Else Dim scrDc As Long, hMemBmp As Long, hwnd As Long #End If Dim w As Long Dim h As Long scrDc = GetDC(0) w = GetDeviceCaps(scrDc, HORZ) h = GetDeviceCaps(scrDc, VERT) hMemDc = CreateCompatibleDC(scrDc) hMemBmp = CreateCompatibleBitmap(scrDc, w, h) SelectObject hMemDc, hMemBmp BitBlt hMemDc, 0, 0, w, h, scrDc, 0, 0, SRCCOPY ReleaseDC 0, scrDc DeleteObject hMemBmp End Sub Private Sub oForm_Layout() Dim k As Long For k = LBound(arFramesArray) To UBound(arFramesArray) UpdateFrameBackGround arFramesArray(k) Next End Sub ثم تقوم بوضع هذا الكود داخل اليوزرفورم عن طريق الضغط عليه دوبل كليك Option Explicit Private oCTransparent As CTransparentFrameMaker Private Sub UserForm_Initialize() Dim oCtl As Control Set oCTransparent = New CTransparentFrameMaker For Each oCtl In Me.Controls If TypeName(oCtl) = "Frame" Then oCTransparent.AddFrame oCtl End If Next End Sub وهذا الملف به تطبيقاً على الفكرة Frame.xlsm ------------------------------------------------------------------------------------------------------------------------------ الحالة الثانية :- لجعل Frame شفافاً بلون Userform الذى اسفله نقوم بوضع هذا الكود بداخل ال userform بالضغط دوبل كليك عليه Private Sub UserForm_activate() With Frame1 .BackColor = BackColor End With End Sub وهذا ملف للتوضيح Frame1.xlsm ----------------------------------------------------------------------------------------------------- الحالة الثالثة :- لجعل userform وال frame شفافاً (وهذا الكود والملف من مشاركات الأستاذ ali mohamed ali ) نقوم بوضع هذا الكود داخل اليوزرفورم عن طريق الضغط على اليوزرفورم دوبل كليك Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_LAYERED = &H80000 Private Const LWA_ALPHA = &H2 Dim hWnd As Long Private Sub UserForm_activate() Dim ufcap As String hWnd = FindWindow("ThunderDFrame", ufcap) hosami Me, 150 End Sub Private Function hosami(frm As UserForm, Level As Byte) As Boolean SetWindowLong hWnd, GWL_EXSTYLE, WS_EX_LAYERED SetLayeredWindowAttributes hWnd, 0, Level, LWA_ALPHA End Function وهذا الملف به تطبيقا للفكرة شفافية اليوزرفورم .xlsm

بسم الله الرحمن الرحيم أبدأ بحمد الله أولا وأخيرا على ما انعم ووفق وأصلي واسلم على الرحمة المهداة والسراج المنير نبينا محمد وعلى آله وصحبه وسلم *********************** لاحظت عبر مشاركات عديدة وكثيرة داخل المنتدي موضوع الكنترول مساهمة مني لاخواني المعلمين فكرت في انشاء برنامج نحاول جمعيا ان نشارك في بناءه ويكون مرن بحيث يمكن تعديله للمراحل المختلفة ( ابتدائي - اعداي - ثانوي - ازهري) ونظرا لاني لا امتلك الخبرة الكافية في مجالات الكنترول بحكم انها مش مجال تخصصي لذلك كان التعاون المثمر بيني وبين اخي الحبيب الأستاذ/ قنديل الصياد بما له من خبرة وباع كبير في مجال الكنترول وكانت البداية من خلاله ومن خلال شيت كنترول المرحلة الابتدائية قام باعداده مسبقا كانت البداية قمت بتقسيم العمل علي اربعة مراحل لتفادي الاخطاء واعطاء فرصة للمراجعة والتدقيق والتطوير المرحلة الاولى: تشمل - عملية البحث المختلفة وفيها البحث عن نتيجة طالب بمعلومية رقم الجلوس من الصف الاول للصف السادس وعرض نتيجة الترمين - امكانية عرض تفاصيل درجات الطالب ومن ثم طباعة شهادة الطالب ( تم الانتهاء منها ) المرحلة الثانية : مرحلة الادخال وتشمل - نماذج ادخال بيانات الطلاب الجدد وتسجيل الدرجات (تحت التنفيذ) - ادخال بيانات المدرسة التي تظهر في جميع النماذج (تم الانتهاء منها ) المرحلة الثالثة : التقارير وتشمل تقارير الطلاب (الناجحين - الراسبين ) ، (ذكور - ايناث ) بحسب الديانة (مسلم - مسيحي ) .... الخ (تحت التنفيذ) المرحلة الاخيرة : النماذج وتشمل نموذج تسجيل طالب او تقرير وزارة التربية والتعليم او النماذج التي يحتاج اليها المعلم والطالب . قمت بطرح الموضوع الان لتجربة الفكرة ولنتشارك جمعيا بالافكار المختلفة للاستكمال العمل ان شاء الله تعالى شرح البرنامج 1- الشاشة الرئيسية للبرنامج 2- القوائم الرئيسية للبرنامج 3- قائمة ملف الفرعية 4- قائمة المساعدة الفرعية 5- شاشة البحث 6- شاشة البحث لاختيار الصف وادخال رقم جلوس الطالب 7- شاشة البحث التي توضح نتيجة الطالب في الترمين الاول والثاني 8- شاشة فرعية توضح درجات الطالب بالتفصيل للترم الاول ويمكن الوصول اليها عند اختيارك (عرض تفاصيل النتيجة ) 9- شاشة فرعية توضح بيانات الطالب للترم الثاني 10- خيار ادخال بيانات المدرسة والتي يظهر في جميع النماذج والفورم فاللهم تقبل منا عملنا هذا خالصا لوجهك الكريم اسأل الله العلي القدير أن يوفقني وإياكم لما فيه الخير الملف تجريبي بالمرفقات تم رفعه بدون معادلات لسهولة الرفع والتحميل تم استبدال الملف (الملف الجديد بالمرفقات ) كنترول زاد - المرحلة الابتدائية نسخة تجريبية 1.rar

ممكن يوزرفورم يقوم بادخال البيانات كما في الصورة اليوزر الفورم للجدول الاول (على اليمين) اليوزر الفورم الثاني للجدول الثاني (على اليسار) مع توضيح إذا امكن (للأكواد) ملاحظة عندما يقوم بتعبئة البيانات في اليوزر فورم اريد ان ينزل تلقائياً للصف بعده، والجدول يتوسع تلقائياً ليشمل البيانات الجديدة (حين يتم تعبئة بيانات على صف جديد) أيضاً مثلاً عند كتابة تاريخ خاطئ يقوم بتنبيه كذلك في في العمود الرابع من كل جدول، يقوم بتنبيه إن كانت القيمة ليست أرقام هذا رابط لملف الاكسل http://www.gulfup.com/?SXGyuW وجزاكم الله خير

طلب مني أخي أ/ إبراهيم أبوليلة في شرح موضوع القوائم المخصصة باستخدام الخصائص المتقدمة لادوات تحكم اليوزر فورم وكنت ساضيفها في موضوع (امثلة عن كيفية استخدام أدوات الفورم ) لكن فضلت ان تكون في موضوع منفصل لسهولة البحث ولتعميم الفائدة اضافة الأكواد الخاصة باظهار كل قائمة من حيث موضعها ومكانها وامكانية رؤيتها القوائم.rar

كثيرا يري كتب الكترونية ومجلات بطرق عرض مختلفة ويستخدم الكثير من البرامج لاتمام العمل ومنها البرامج البسيطة ومنها البرامج الاحترافية السؤال هل يمكن تطويع الخصائص المتقدمة للفورم ونقوم باخراج كامل لكتاب او مجلة عن طريق الاكسيل ونستغني عن البرامج الاخري الأجابة نعم نستطيع وبفكرة بسيطة جدا ان نخرج عمل بل يصل لعمل احترافي لاخراج كتاب او مجلة الكترونية باستخدام الـVBA اكسيل ويمكن ان نضيف له معاينة وتكبير وتصغير وطباعة وتصدير الي صورة وتصدير الي PDF وهايبر لينك مجرد البداية قمت بتطبيقها علي عجالة علي المجلة الشهرية العدد الاول - مارس 2014م لاوضح الفكرة ومضمونها وان شاء سنمضي في تنفيذها وتطويرها وعمل قوالب جاهزة تسهيلا للمستخدم واضافة المميزات الاخري من تصدير الي صورة او بي دي اف او طباعة والهايبر لينك واضافة فهرس وارتباطات تشعبية للموضوعات شرح بسيط للفورم واترككم للتجربة وفي انتظار مقترحاتكم لتطوير العمل ان شاء الله تعالي تقبلوا تحياتي مجلة اوفيسنا - مارس 2014.rar