حمادة عمر

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

السلام عليكم الاستاذ العزيز / مجدى يونس بارك الله فيك وجاري تنزيل الملف وبالطبع ومن الاكيد دون ان آراه فهو راااائع بك تأكيد ... لانها عادتك وعادة افكارك الجميله جزاك الله خيرا

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

السلام عليكم الاستاذ القدير / سعيد بيرم بارك الله فيك كلماتك اكثر من راااائعة ولها تأثير كبير في قلب وعقل كل من يقرأها جزاك الله خيرا

السلام عليكم الاخ العزيز / سعد عابد بارك الله فيك وجعله الله في ميزان حسناتك

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

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

لقد اعجبت انا باللعبة كثييييييييييييييييييييييييييييييرا فهي بالفعل راااااااااااائعة ولي عودة اخري استاذنا انت رااااااائع كعادتك دائما

السلام عليكم الاستاذ القدير / رجب جاويش بارك الله فيك مرورك دائما علي اي موضوع شرف له والف مليون شكر علي تحيتك لي ولا بنتي وتقبل تحياتي الغالية لك ولاسرتك الكريمة فردا فردا جزاك الله خيرا

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

السلام عليكم الاستاذ العزيز / مجدى يونس بارك الله فيك وعدت فاوفيت فصدقت استاذي الكريم انت رااائع حقا والله لا تعلم مدي سعادتي انا بهذه للعبة ... رغم انني ما زلت اقوم بتحميلها وساجعل ابنتي سما تشاهدها ... واخبرك بالنتيجة جزاك الله خيرا

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

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

السلام عليكم الاخت الفاضلة المهندسة / سما محمد بارك الله فيكي وجزاك الله خيرا

السلام عليكم الاخت الفاضلة المهندسة / سما محمد اتفق معكي فعلا في رأيك بانه لا يوجد مستحيل هنا مع خبراؤنا واساتذتنا العظام واليكي اختي الكريمة الحل في المرفق وهو كود للقدير الرائع / جعفر طرباق ... جزاه الله خيرا يقوم بعمل ما تريديه بالضبط وتم تنفيذه علي ملفك ومرفق ملفك ... وملف للاستاذ / جعفر به الاكواد واليكم الكود ايضا جزاكي الله خيرا فورم شفاف+.rar TransparentForm.rar Option Explicit Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biRUsed As Long biRImportant As Long End Type Private Type BITMAPINFO_NoColors bmiHeader As BITMAPINFOHEADER End Type Private Type BITMAPFILEHEADER bfType As Integer bfSize As Long bfReserved1 As Integer bfReserved2 As Integer bfOffBits As Long End Type Private Type MemoryBitmap hdc As Long hBM As Long oldhDC As Long wid As Long hgt As Long bitmap_info As BITMAPINFO_NoColors End Type Private Declare Function CreateDIBSection Lib "gdi32" _ (ByVal hdc As Long, pBitmapInfo As BITMAPINFO_NoColors, _ ByVal un As Long, ByVal lplpVoid As Long, _ ByVal handle As Long, ByVal dw As Long) _ As Long Private Declare Function GetDIBits Lib "gdi32" _ (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal _ nStartScan As Long, ByVal nNumScans As Long, _ lpBits As Any, lpBI As BITMAPINFO_NoColors, _ ByVal wUsage As Long) _ As Long Private Declare Function FindWindow Lib "user32.dll" _ Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function GetWindow Lib "user32.dll" _ (ByVal hwnd As Long, ByVal wCmd As Long) As Long Private Declare Function ClientToScreen Lib "user32.dll" _ (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long Private Declare Function GetDC Lib "user32.dll" _ (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32.dll" _ (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function GetClientRect Lib "user32.dll" _ (ByVal hwnd As Long, ByRef lpRect As RECT) 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 CreateCompatibleDC Lib "gdi32.dll" _ (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" _ (ByVal hdc As Long, ByVal nWidth As Long, _ ByVal nHeight As Long) As Long Private Declare Function DeleteObject Lib "gdi32.dll" _ (ByVal hObject As Long) As Long Private Declare Function SelectObject Lib "gdi32.dll" _ (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" _ (ByVal hdc As Long) As Long Private Declare Function GetSystemMetrics Lib "user32" _ (ByVal nIndex As Long) As Long Private Declare Function PrintWindow Lib "user32" _ (ByVal hwnd As Long, ByVal hdcBlt As Long, _ ByVal nFlags As Long) As Long Private Const PICTYPE_BITMAP = 1 Private Const DIB_RGB_COLORS = 0& Private Const BI_RGB = 0& Private Const SRCCOPY = &HCC0020 Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Const SM_CYBORDER = 6 Private Const SM_CYDLGFRAME = 8 Private WithEvents wb As Workbook Private Sub UserForm_Initialize() Set wb = ThisWorkbook Call Paint_UserForm End Sub Private Sub UserForm_Layout() Call Paint_UserForm End Sub Private Sub wb_SheetSelectionChange _ (ByVal Sh As Object, ByVal Target As Range) Call Paint_UserForm End Sub Private Sub Paint_UserForm() Dim tRect As RECT Dim tpt As POINTAPI Dim memory_bitmap As MemoryBitmap Dim frmDc As Long Dim memDc As Long Dim scrDc As Long Dim oldDc As Long Dim tempBmp As Long Dim frmHwnd As Long Dim frmClientWid As Long Dim frmClientHgt As Long Dim scrWid As Long Dim scrHgt As Long Dim X As Long Dim Y As Long frmHwnd = FindWindow(vbNullString, Me.Caption) frmDc = GetDC(frmHwnd) GetClientRect frmHwnd, tRect With tRect frmClientWid = .Right - .Left frmClientHgt = .Bottom - .Top End With scrWid = GetSystemMetrics(SM_CXSCREEN) scrHgt = GetSystemMetrics(SM_CYSCREEN) scrDc = GetDC(0) memDc = CreateCompatibleDC(scrDc) tempBmp = CreateCompatibleBitmap(scrDc, scrWid, scrHgt) oldDc = SelectObject(memDc, tempBmp) PrintWindow Application.hwnd, memDc, 1 memory_bitmap = _ MakeMemoryBitmap(memDc, frmClientWid, frmClientHgt) Call ClientToScreen(frmHwnd, tpt) X = tpt.X Y = tpt.Y BitBlt memory_bitmap.hdc, 0, 0, frmClientWid, frmClientHgt, _ memDc, X + 8, Y + GetSystemMetrics(SM_CYDLGFRAME) + _ GetSystemMetrics(SM_CYBORDER), SRCCOPY SaveMemoryBitmap memory_bitmap, Environ("Temp") & "\temp.bmp" Set Me.Picture = LoadPicture(Environ("Temp") & "\temp.bmp") ReleaseDC 0, scrDc ReleaseDC frmHwnd, frmDc SelectObject memDc, oldDc DeleteObject tempBmp DeleteObject memDc SelectObject memory_bitmap.hdc, memory_bitmap.oldhDC DeleteObject memory_bitmap.hBM DeleteDC memory_bitmap.hdc End Sub Private Function MakeMemoryBitmap _ (memDc As Long, wid As Long, hgt As Long) As MemoryBitmap Dim result As MemoryBitmap Dim bytes_per_scanLine As Long Dim pad_per_scanLine As Long result.hdc = CreateCompatibleDC(memDc) With result.bitmap_info.bmiHeader .biBitCount = 32 .biCompression = BI_RGB .biPlanes = 1 .biSize = Len(result.bitmap_info.bmiHeader) .biWidth = wid .biHeight = hgt bytes_per_scanLine = ((((.biWidth * .biBitCount) + _ 31) \ 32) * 4) pad_per_scanLine = bytes_per_scanLine - (((.biWidth _ * .biBitCount) + 7) \ 8) .biSizeImage = bytes_per_scanLine * Abs(.biHeight) End With result.hBM = CreateDIBSection( _ result.hdc, result.bitmap_info, _ DIB_RGB_COLORS, ByVal 0&, _ ByVal 0&, ByVal 0&) result.oldhDC = SelectObject(result.hdc, result.hBM) result.wid = wid result.hgt = hgt MakeMemoryBitmap = result End Function Private Sub SaveMemoryBitmap( _ memory_bitmap As MemoryBitmap, _ ByVal file_name As String _ ) Dim bitmap_file_header As BITMAPFILEHEADER Dim fnum As Integer Dim pixels() As Byte With bitmap_file_header .bfType = &H4D42 .bfOffBits = Len(bitmap_file_header) + _ Len(memory_bitmap.bitmap_info.bmiHeader) .bfSize = .bfOffBits + _ memory_bitmap.bitmap_info.bmiHeader.biSizeImage End With fnum = FreeFile Open file_name For Binary As fnum Put #fnum, , bitmap_file_header Put #fnum, , memory_bitmap.bitmap_info ReDim pixels(1 To 4, _ 1 To memory_bitmap.wid, _ 1 To memory_bitmap.hgt) GetDIBits memory_bitmap.hdc, memory_bitmap.hBM, _ 0, memory_bitmap.hgt, pixels(1, 1, 1), _ memory_bitmap.bitmap_info, DIB_RGB_COLORS Put #fnum, , pixels Close fnum End Sub

طريقة عمل شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل !! خطوة خطوة السلام عليكم اساتذة المنتدي وخبراؤه الكبار الاخوة الافاضل بالطبع هناك اكواد كثيرة لعمل شاشة الادخال وكذلك الاستعلام والتعديل والحذف ولكني قصدت اختيار اسهل هذه الاكواد لعمل ذلك لتكون اسهل في توصيل المعلومة وكذلك اسهل عند التطبيق وارجو من الله ان اكون قد وفقت في عمل ذلك (((( الدرس الخامس )))) شاشة ( فورم ) لادخال بيانات والقيام بتسجيل وترحيل هذه البيانات الي صفحة الاكسيل و الاستعلام من خلالها عن طريق نفس الفورم والتعديل ايضا في البيانات في حالة ما اردنا التعديل في بيان قد سبق ادخاله وطبعاً والاكيد كله من علمكم اساتذتي الكرام الاجلاء في هذا الدرس سنتعرف علي طريقة عمل زر للحذف بعد عمل استعلام عن الاسم او الرقم المطلوب وذلك في نفس الفورم الذي قمنا بتصميمه وذلك للبيانات السابق تسجيلها في صفحة البيانات وذلك عن طريق استخدام زر الحذف ... مع وضع اكواده ... وشرح الكود سطر سطر كما تعودنا واي استفسار .... في الخدمة دائما ... واي شئ غير واضح في الشرح علي استعداد تام لشرحه مرة اخري ومرات اخري واليكم ايضا في المرفقات : 1- ملف اكسيل به الاكواد والشرح هذه المرة داخل الكود ( تم شرح الكود سطر سطر بطريقة وافية وبسيطة جدا داخل الكود نفسه ) 2- عدد ( 1 ) ملف فيديو يشرح طريقة التصميم واضافة الاكواد وكذلك مشاهدة النتيجة واضافة بسيطة لكفاءة عمل زر تسجيل جديد جزاكم الله خيرا اساتذتنا اكسيل ..طريقة عمل شاشة ادخال واستعلام وتعديل وحذف5.rar طريقة عمل زر الحذف فيديو.rar ارجو من الله ان اكون قد وفقت فيما تم تقديمه من شرح وان يكون كل شئ واااضح وبطريقة اعجبتكم وانا علي استعداد تام لشرح اي جزء مرة اخري

السلام عليكم اخي العزيز / عمرو_ بارك الله فيك اخي الكريم علي مشاركتك الرائعة والمفيده حقا وبالنسبة لكلمتك ( وارجو ان اكون ما فهمته صحيح ) فبالفعل بعد مشاهدة ردك هذا اتضح لي انني انا الذي لم افهم المقصود كما ينبغي وقد اتضح لي لآن جزاك الله كل الخير اخي الكريم

السلام عليكم الاخ الكريم / apt قم بارفاق الملف المقصود للوقوف علي الخطأ جزاك الله خيرا

السلام عليكم الاخ الكريم / mfouda بارك الله فيك جزاك الله خيرا

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

السلام عليكم الاخ الكريم / nisarrr شاهد الفيديو المرفق ( وطبعا يجب ان تكون الصور في نفس المجلد ) الشرح فيديو.rar

السلام عليكم الاستاذ والاخ العزيز / سعيد بيرم بارك الله فيك وجزاك الله خيرا وادعو لك من كل قلبي وبظهر الغيب ان يوفقك الله

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

السلام عليكم الاخ الكريم / nisarrr بعد اذن الاخ العزيز / احمد عبد الناصر .... جزاه الله خيرا قم بعمل تصميم Image في ورقة الاكسيل ثم قم بوضع الكود التالي في حدث الورقة نفسها ( as ) وقم بتحديد الخلية التي وضع رقم الكمبيوتر بها وهي هنا في الكود التالي c6 كما في ملفك المرفق ( قم بتغيير رقم الخليه كما تريد ) Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo 1 If Target.Address = [c6].Address Then Image1.Picture = LoadPicture(ActiveWorkbook.Path & "\" & [c6].Value & ".jpg") End If If f > 2000 Then 1: Image1.Picture = LoadPicture("") End If End Sub ثم ضع هذا الكود البسيط في حدث ThisWorkbook Private Sub Workbook_BeforeClose(Cancel As Boolean) Sheets("as").Image1.Picture = LoadPicture("") End Sub واي توضيح كلنا هنا لخدمة بعضنا البعض جزاك الله خيرا

السلام عليكم اخي العزيز / عباس السماوي بارك الله فيك مشاركاتك دائما لها مذاق خاص جزاك الله خيرا