نجوم المشاركات

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

أستاذي الفاضل ابراهيم أبو ليله لا شكر على واجب .. فأفضالك عل المنتدى بصفة عامّة وعلينا بصفة خاصّة .. لا تنتهي .. ولا تُحصى و لا تُعد جزاك الله خيرًا و زادك من علمه و فضله احتراماتي

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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله مع التحديث الجديد .. للأسف لم أجد التوجيهات التي تم وضعها من قبل ، وهذه القواعد والأسس هامة جداً ليدرك الأعضاء كيفية التعامل مع المنتدى طبعاً الموضوع سيكون متجدد .. سيتم وضع القواعد مرة أخرى فالرجاء الرجاء أن تساعدوني في اتمام الأمر .. كل عضو يذكرني بتوجيه من هذه التوجيهات ليتم إرساء القواعد ، إذ أن نجاح أي مؤسسة يعتمد في المقام الأول على قواعد ومنهج ثابت للسير على دربه التوجيهات والقواعد التي يجب مراعاتها التوجيه الأول : قبل طرح موضوع جديد يتعلق بطلب محدد يرجى استخدام خاصية البحث أولاً ، فإذا لم يجد طارح الموضوع بغيته ، فعليه أن يقوم بطرح موضوع جديد ، وفي هذه الحالة على طارح الموضوع أن يعلم أن حسن السؤال شطر الإجابة ، فاللباقة واللياقة والكياسة من الصفات التي يجب أن يتحلى بها طالب العلم. التوجيه الثاني : عند طرح موضوع جديد ، يتم وضع عنوان مناسب للطلب بحيث يفهم الطلب قبل الإطلاع عليه ، وعلى طارح الموضوع أن يبتعد عن العناوين الغير مجدية مثل : ( طلب مساعدة - الرجاء المساعدة - ساعدوني من فضلكم - عاجل وهام - الحقوني - نداء للعباقرة - نداء للعمالقة - إلى آخر تلك العناوين ...) ، وأمر آخر ألا يكون العنوان على شكل سؤال أو طلب .. نبتعد عن كلمة "طلب" مثال تطبيقي : نفترض أنني أريد معادلة تجمع القيم في عمودين العنوان المناسب للطلب يكون بهذا الشكل : معادلة جمع القيم في عمودين والنتائج في عمود آخر التوجيه الثالث : أن يتم توضيح المطلوب بالموضوع بشكل يزال معه أي لبس ، وفي نفس الوقت يراعى الإجمال في الطلب ، فأقصر الخطوط هو الخط المستقيم ، بمعنى "لا إطالة مملة ولا اختصار مخل" ، أي لا يكون طرح الموضوع مختصر للغاية بل يجب أن يستوفي جميع العناصر المطلوبة ، ومن ضمنها أن يحدد طارح الموضوع هل الحل المطلوب بالمعادلات أم بالأكواد أم بكلاهما لتكون الأمور واضحة بالنسبة لمن يريد تقديم المساعدة ، وأن يقوم صاحب الموضوع بإرفاق ملف به بيانات وهمية لتوضيح طلبه وللوصول إلى حل سريع ودقيق ، وإذا صعب على طارح الموضوع شرح المطلوب يمكنه إرفاق بعض النتائج المتوقعة كي يسهل الوصول لحل. التوجيه الرابع : نلاحظ أن شكل المنتدى لا يعجب معظم الأعضاء ، فلما لا نغير بأيدينا الشكل العام للمشاركات ، فيفضل على سبيل المثال استخدام حجم خط كبير 22 على سبيل المثال وجعل الخط عريض Bold مما يجعل المشاركة واضحة ومقروءة بشكل جيد ، كما يمكن استخدام الألوان أي قم بتنسيق المشاركة بشكل جذاب يجعل القاريء لا ينفر منها. التوجيه الخامس : بعد الانتهاء من الموضوع والوصول لحل يرضي صاحب الموضوع ، يرجى أن يتم تحديد أفضل إجابة من خلال النقر على علامة الصح الموجودة بجانب كل مشاركة ، وأن يسجل صاحب الموضوع إعجابه من خلال النقر على "سجل اعجاب بهذا" كنوع من رد الجميل لمن قدم المساعدة ، ويمكن أيضاً أن يقوم بتقييم المشاركة تقييم إيجابي كنوع من التقدير ، وأن تشكر من قدم المساعدة فمن لم يشكر الناس لا يشكر الله. فيما يخص لو كان هناك أكثر من إجابة للموضوع ، يمكن لصاحب الموضوع عمل مشاركة جديدة يجمع فيها كل الحلول ويختار هذه المشاركة كأفضل إجابة التوجيه السادس : لا تكن لحوحاً ، يكفي أن أعضاء المنتدى يقدمون وقتهم و خبرتهم مقابل لا شيء وعندهم أعمال أخرى (مشاغلهم الخاصة) يقومون بها ، و إذا تأخر الرد ، فمن الممكن أن يكون أحد الأعضاء يقوم بمحاولة الإجابة ، وهذا يستغرق بعض الوقت خاصةً إذا كان الموضوع صعباً. التوجيه السابع : حمل الملف المرفق دون زركشات (ألوان و تنسيقات مختلفة) مما يزيد من حجم الملف و أحياناً تكون الألوان مقززة بشكل ينفر منها المساعد (خاصةً إذا كانت ألوان الخلايا غير متناسقة مع لون الخط) التوجيه الثامن : تأكد أن الملف المرفوع غير مصاب بفيروس و غير محمي بكلمة سر ، وإلا لن تجد المساعدة من قبل الأعضاء. التوجيه التاسع : متابعة صاحب الموضوع لموضوعه والتفاعل معه ، فلا يعقل أن يطرح أحدهم موضوع ولا يتابعه إلا بعد مرور وقت طويل ، فهذا يعد من اللامبالاة الغير مرغوب فيها ، والتي تنفر الجميع من العضو. التوجيه العاشر : عدم التسجيل في المنتدى بأكثر من حساب ، وأن يكون اسم الظهور باللغة العربية ومعبر عن الاسم الحقيقي أي (تعريب اسم العضو) ، فلا يجوز أن يكون اسم الظهور اسم واحد وفقط بل أن يكون ثنائي على الأقل أو أن يكون اسم ولقب ، ولذا يرجى عدم استخدام الأسماء المستعارة أو الأسماء باللغة الأجنبية ، فاللغة العربية هي هويتنا ولابد من الحافظ عليها. ** يتم تغيير اسم الظهور أو اسم المستخدم من خلال إعدادات الحساب ثم التبويب اسم المستخدم ، قم بتغيير الاسم ثم انقر كلمة حفظ التوجيه الحادي عشر : عدم طرح أكثر من موضوع لنفس الطلب من نفس العضو ، فهذا يعد مخالفة صريحة ، وليعلم العضو الذي يقوم بذلك أن تكرار الموضوع لن يجدي نفعاً في حالة عدم توضيحه للمطلوب. وفي حالة أن قام العضو بذلك عن طريق الخطأ يقوم العضو بالتنويه في الموضوع وطلب حذف الموضوع نظراً لتكراره. التوجيه الثاني عشر : على من يقدم المساعدة أن يكون مثالاً يحتذى به في العطاء والصبر والحلم وكرم الأخلاق وحسن الإجابة ، يجتذب بتلك الصفات عقول الآخرين وأفئدتهم التوجيه الثالث عشر : عند طرح موضوع يفضل أن يكون هناك طلب واحد فقط إذ أن الموضوع الذي تكثر فيه الطلبات ينفر الأعضاء الذين يريدون تقديم يد المساعدة ، وعلى رأي المثل (من يطارد عصفورين يفقدهما) فما بالك لو طاردت أكثر من طلبين أقصد أكثر من عصفورين ، يمكنك أن تتعامل بذكاء بأن تطرح الموضوع بطلب واحد حتى إذا تم على خير قم على الفور بطرح موضع جديد بطلب جديد وهكذا إلى أن يتم الأمر التوجيه الرابع عشر : يرجلا عدم إرسال رسائل خاصة للأعضاء لطلب المساعدة بشكل شخصي ، لأن هذا الأمر يضايق الكثير من الأعضاء ، وتأكد أن العضو إذا كان لديه معلومة أو يستطيع أن يفيد بشيء ووقته يسمح بذلك فلن يتأخر عنك ، يكفي أن تكتب كلمة "للرفع" في موضوعك ، ليشاهده أكبر عدد من الأعضاء. ** كيفية رفع الصور في المشاركات : ******************************* دمتم على طاعة الله

السلام عليكم الفكرة جميله وتنفع فى جدولة الأعمال او اعياد الميلاد لكن فيها خطأ برمجى صغير فى السطر expd = Worksheets("Notifications").Range("A2") المفروض انه يقرا من الخلية A1 فى الشيت Main expd = Worksheets("Main").Range("A1") وكمان تبقى افضل لو حدد ادنى للتاريخ انه ما يكونش اقل من تاريخ اليوم لانى لاحظت انه جايب لى تنبيهات من سنة فاتت بتغيير السطر التالى If (.Cells(irow, 7) - MyDate) <= expd Then الى If (.Cells(irow, 7) - MyDate) <= expd And (.Cells(irow, 7) - MyDate) > -1 Then تنبيهات 1.rar

جرب المرفق... لعل فيه المطلوب بن علية ترقيم حسب الشهر لمعيار معين.zip

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

الاخ العزيز ساشرح لك طريقة وان شاء الله تفيدك قم بعمل ملف جديد وضع فيه ملفك ثم قم بفتح درايف الـ C ثم اختر Programfiles ثم قم بفتح مجلد برنامج الـ WinRAR ثم انسخ منه الملف UnRAR زوضعه داخل المجلد الذى قمت بانشائه من قبل ووضعت فيه ملفك ثم قم بفتح المفكرة وانسخ بها الكود التالى ثم احفظه بداخل المجلد باسم Passwardcrcker.Bat ثم قم بالضغط على هذا الملف الذى قمت بانشاءه وقم بنسخ مسار ملف من داخل المجلد الذى انشاته ثم الصقه داخل الشاشة السوداء التى ستظهر معك بعد الضغط على الملف الذى به الكود واضغط انتر وانتظر حتى تظهر لك كلمة السر الخاصة بملفك مرفق الكود WinRAR Password _er.rar

استاذى الحبيب حضرتك تقصد الكتابه فى التكست بوكس فأذا كنت تقصد ذالك نعم فقط قم بنسخ الكود وضعه فى حدث Exit للتكست بوكس Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'انسخ الكود هنا End Sub أو حدث AfterUpdate للتكست بوكس Private Sub TextBox1_AfterUpdate() 'انسخ الكود هنا End Sub كلاهما يؤدى نفس الغرض وجرب بنفسك وستجد ما يسرك تقبل تحياتى

الاخ الكريم عبدالعزيز ما اروع ما قدمت جزاكم الله خيرا مرفق ملفى الذى تقدمت به من قبل ولكن بعد التعديل وتدراك الخطأ تقبلوا تحياتى Book1 - Copy.zip

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

السلام عليكم لقد انتهيت من تصميم الفورم و الكود .. كتبت الكود و جربته على أوفيس 2007 ويندوز XP طبعا ينبغي تعديل ال API Declarations لكي يعمل الكود على الويندوز 64 بت ارجو أن يعجبكم العمل لقطة من اشاشة : ملف للتحميل : https://app.box.com/s/pn0ogngk3swhfbxbugk8f87ookrqb18b الكود: 1- كود في موديول الفورم: PaintingPuzzleGame 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 GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type uPicDesc Size As Long Type As Long hPic As Long hPal As Long End Type Private Declare Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 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 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 GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function InvalidateRect Lib "User32.dll" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function PlaySoundAPI Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long Private Const PICTYPE_BITMAP = &H1 Private Const SRCCOPY = &HCC0020 Private Const SM_CXSCREEN = 0 Private Const SM_CYSCREEN = 1 Private Const SND_ASYNC As Long = &H1 Private Const SND_FILENAME As Long = &H20000 Private Const SND_LOOP As Long = &H8 Private Const SND_PURGE = &H40 'Module level variables Private oCol As Collection Private oPic As Object Private bScore As Boolean Private bExit As Boolean Private bAbort As Boolean Private InitialFormLeft As Single Private InitialFormTop As Single Private lFrmHwnd As Long Private lCounter As Long Private lTotalImageParts As Long Private lColumns As Long Private lRows As Long Private sLevel As String Private sUserName As String Private vFileName As Variant Private Sub UserForm_Initialize() sUserName = InputBox("Please, enter your name", "Player Name") If Len(sUserName) = 0 And StrPtr(sUserName) <> 0 Then MsgBox "You must enter a player name", vbInformation: End If StrPtr(sUserName) = 0 Then End End Sub Private Sub UserForm_Activate() StartUpPosition = 2 InitialFormLeft = Me.Left InitialFormTop = Me.Top Set oPic = frameSourcePic.Picture lFrmHwnd = FindWindow(vbNullString, Me.Caption) frameSourcePic.BorderStyle = fmBorderStyleSingle frameSourcePic.BorderColor = vbYellow With Me.ComboLevel .AddItem "Easy " & " (3x6 Parts)" .AddItem "low " & " (3x8 Parts)" .AddItem "Medium " & "(4x10 Parts)" .AddItem "High " & "(6x13 Parts)" .ListIndex = 0 End With lblTimer.Caption = "" CBtnAbort.Enabled = False Call EnableControls(True) End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If MsgBox("Are you sure you want to quit ?", vbQuestion + vbYesNo) = vbNo Then Cancel = 1 Exit Sub End If bExit = True End Sub '*************************************************************************************************** 'Event handlers of form's controls Private Sub ComboLevel_Change() Select Case True Case UCase(ComboLevel.Value) Like "EASY*" lRows = 3 lColumns = 6 Case UCase(ComboLevel.Value) Like "LOW*" lRows = 3 lColumns = 8 Case UCase(ComboLevel.Value) Like "MEDIUM*" lRows = 4 lColumns = 10 Case UCase(ComboLevel.Value) Like "HIGH*" lRows = 6 lColumns = 13 End Select sLevel = UCase(ComboLevel.Value) End Sub Private Sub CBtnAbort_Click() Call EnableControls(False) bAbort = True End Sub Private Sub CBtnClose_Click() Unload Me End Sub Private Sub CBtnNewPic_Click() On Error GoTo errHandler vFileName = Application.GetOpenFilename(FileFilter:="Picture Files (*.gif;*.jpg;*.jpeg;*.bmp),*.gif;*.jpg;*.jpeg;*.bmp", _ Title:="Select Picture") If vFileName <> False Then frameSourcePic.Picture = LoadPicture(vFileName) Call DeletePreviousImages End If Exit Sub errHandler: MsgBox Err.Description End Sub Private Sub CBtnStart_Click() Dim oImagePartCls As oImagePartCls Dim oTextBox As msforms.TextBox Dim tRect As RECT Dim tPt1 As POINTAPI, tPt2 As POINTAPI Dim BasePicframeHwnd As Long Dim lImgPartWidth As Long, lImgPartHeight As Long Dim lImgPartLeft As Long, lImgPartTop As Long Dim lColumn As Long, lRow As Long Dim lControlCounter As Long bScore = False bAbort = False Call EnableControls(False) BasePicframeHwnd = frameSourcePic.[_GethWnd] GetWindowRect BasePicframeHwnd, tRect tPt1.X = tRect.Left tPt1.y = tRect.Top tPt2.X = tRect.Right tPt2.y = tRect.Bottom If IsFormClipped(tPt1, tPt2) Then Me.Move InitialFormLeft, InitialFormTop GetWindowRect BasePicframeHwnd, tRect DoEvents End If Call DeletePreviousImages 'add the image parts controls Set oCol = New Collection For lColumn = 1 To lRows For lRow = 1 To lColumns lControlCounter = lControlCounter + 1 Set oImagePartCls = New oImagePartCls Set oImagePartCls.GetForm = Me Set oImagePartCls.PicturePart = Controls.Add("Forms.Image.1", "Image" & lControlCounter) With oImagePartCls.PicturePart .PictureSizeMode = fmPictureSizeModeStretch .BorderStyle = fmBorderStyleSingle .BorderColor = vbYellow .MousePointer = fmMousePointerSizeAll .Width = frameSourcePic.Width / lRows .Height = frameSourcePic.Height / lColumns .Left = frameSourcePic.Left + (((lRow - 1) * (frameSourcePic.Width + 20) / lRows)) .Top = 20 + (((lColumn - 1) * (frameSourcePic.Height + 20) / lColumns)) .ZOrder 0 .ControlTipText = "Drag the Picture down to its corresponding empty frame below" End With oCol.Add oImagePartCls Next Next 'add the textbox holder controls lControlCounter = 0 For lRow = 1 To lColumns For lColumn = 1 To lRows lControlCounter = lControlCounter + 1 Set oTextBox = Controls.Add("Forms.TextBox.1", "TextBox" & lControlCounter) With oTextBox .Enabled = False .BackStyle = fmBackStyleTransparent .BorderStyle = fmBorderStyleSingle .SpecialEffect = fmSpecialEffectEtched .Left = frameSourcePic.Left + frameSourcePic.Width + 80 + lColumn * frameSourcePic.Width / lRows .Top = frameSourcePic.Top + (lRow - 1) * frameSourcePic.Height / lColumns .Width = oImagePartCls.PicturePart.Width .Height = oImagePartCls.PicturePart.Height .ZOrder 1 End With Next Next 'randomly shuffle the image part controls lTotalImageParts = lColumns * lRows Me.Tag = lTotalImageParts ReDim iArray(1 To lTotalImageParts) As Integer ' Call ShufflePictureParts(lTotalImageParts, iArray) 'set the Pic property of each image part lControlCounter = 0 For lColumn = 1 To lColumns For lRow = 1 To lRows With tRect lImgPartWidth = (.Right - .Left) / lRows lImgPartHeight = (.Bottom - .Top) / lColumns lImgPartLeft = .Left + ((lRow - 1) * lImgPartWidth) lImgPartTop = .Top + ((lColumn - 1) * lImgPartHeight) End With lControlCounter = lControlCounter + 1 Controls("image" & iArray(lControlCounter)).Tag = Controls("TextBox" & lControlCounter).Name CropPic lImgPartWidth, lImgPartHeight, lImgPartLeft, lImgPartTop, Me.Controls("image" & iArray(lControlCounter)) InvalidateRect lFrmHwnd, 0, 0 Next Next frameSourcePic.BorderStyle = fmBorderStyleSingle frameSourcePic.BorderColor = vbYellow Call UpdateTimerLabel End Sub '************************************************************************************************* ' Private Supporting routines Private Sub UpdateTimerLabel() Dim ss As Long Dim mm As Long Dim hh As Long Dim sglTimer As Single Const WAV_FILE As String = "C:\WINDOWS\MEDIA\tada.WAV" sglTimer = Timer Do ss = Int(Timer - sglTimer) If ss = 60 Then mm = mm + 1: ss = 0: sglTimer = Timer If mm = 60 Then hh = hh + 1: mm = 0: sglTimer = Timer lblTimer.Caption = Format(hh, "00") & " Hrs : " & Format(mm, "00") & " mins : " & Format(ss, "00") & " Secs" DoEvents Loop Until bExit Or bScore Or bAbort If bScore Then PlaySoundAPI WAV_FILE, ByVal 0&, SND_FILENAME Or SND_LOOP Or SND_ASYNC If MsgBox("Congratulations " & sUserName & " !!" & vbCrLf & vbCrLf & _ "You scored in : " & Format(hh, "00") & " Hrs : " & Format(mm, "00") & " mins : " & Format(ss, "00") & " Secs" & vbCrLf & _ "Do you want to save this score to your scores history ?", vbQuestion + vbYesNo) = vbYes Then Call SaveTheScore(hh, mm, ss) End If PlaySoundAPI WAV_FILE, ByVal 0&, SND_FILENAME Or SND_PURGE End If lblTimer.Caption = "" Call EnableControls(True) Call DeletePreviousImages Set frameSourcePic.Picture = oPic End Sub Private Sub SaveTheScore(ByVal hh As Long, mm As Long, ByVal ss As Long) Dim bProtection As Boolean bProtection = ActiveSheet.ProtectContents If bProtection Then ActiveSheet.Unprotect End If With Cells(Cells.Rows.Count, 1).End(xlUp) .Offset(1, 0) = sUserName .Offset(1, 1) = Now .Offset(1, 2) = IIf(vFileName = Empty, "Default Picture", vFileName) .Offset(1, 3) = sLevel .Offset(1, 4) = Format(hh, "00") & " Hrs : " & Format(mm, "00") & " mins : " & Format(ss, "00") & " Secs" End With If bProtection Then ActiveSheet.Protect End If ThisWorkbook.Save End Sub Private Sub CropPic(ByVal nWidth, ByVal nHeight, ByVal X, ByVal y, DestCtrl As Image) Dim hdc As Long Dim hDCMemory As Long Dim hBmp As Long Dim OldBMP As Long Dim IID_IDispatch As GUID Dim uPicinfo As uPicDesc Dim IPic As IPicture hdc = GetDC(0) hDCMemory = CreateCompatibleDC(hdc) hBmp = CreateCompatibleBitmap(hdc, nWidth, nHeight) OldBMP = SelectObject(hDCMemory, hBmp) Call BitBlt(hDCMemory, 0, 0, nWidth, nHeight, hdc, X, y, SRCCOPY) 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, True, IPic Set DestCtrl.Picture = IPic ReleaseDC 0, hdc DeleteObject OldBMP DeleteDC hDCMemory End Sub Private Sub ShufflePictureParts(ByVal NumOfPics, ByRef Arr() As Integer) Dim i As Integer, lRandomNumber As Integer, temp As Integer For i = 1 To NumOfPics Arr(i) = i Next i Randomize Timer For i = 1 To NumOfPics lRandomNumber = Int(Rnd * (UBound(Arr) - LBound(Arr) + 1) + LBound(Arr)) temp = Arr(i) Arr(i) = Arr(lRandomNumber) Arr(lRandomNumber) = temp Next i End Sub Private Sub DeletePreviousImages() Dim i As Long Dim oCtl As Control On Error Resume Next If Not oCol Is Nothing Then For i = 1 To oCol.Count Controls.Remove Controls("Image" & i).Name Next For Each oCtl In Me.Controls If TypeName(oCtl) = "TextBox" Then Controls.Remove oCtl.Name End If If TypeName(oCtl) = "Image" Then Controls.Remove oCtl.Name End If Next End If End Sub Private Function IsFormClipped(tLeftTop As POINTAPI, tRightBottom As POINTAPI) As Boolean IsFormClipped = _ tLeftTop.X <= 1 Or tLeftTop.y <= 1 Or tRightBottom.X >= GetSystemMetrics(SM_CXSCREEN) - 1 Or _ tRightBottom.y >= GetSystemMetrics(SM_CYSCREEN) - 1 End Function Private Sub EnableControls(ByVal Bool As Boolean) CBtnAbort.Enabled = Not Bool CBtnNewPic.Enabled = Bool CBtnStart.Enabled = Bool ComboLevel.Enabled = Bool End Sub '************************************************************************************************************* ' Public Methods Public Sub MsgbBeep() MessageBeep &H40& End Sub Public Sub FlashImagePart(ByVal Img As Image, ByVal ct As msforms.TextBox) Dim i As Long Dim t As Single For i = 0 To 1 Img.BorderStyle = fmBorderStyleSingle Img.BorderColor = vbRed t = Timer Do DoEvents Loop Until Timer - t >= 0.2 Img.BorderStyle = fmBorderStyleNone Next End Sub Public Sub CheckIfSuccess() Dim oCtrl As Control Dim lCounter As Long For Each oCtrl In Me.Controls If TypeName(oCtrl) = "Image" Then If InStr(1, oCtrl.Tag, "Success") Then lCounter = lCounter + 1 If lCounter = lTotalImageParts Then bScore = True End If End If End If Next End Sub 2- الكود في الكلاس موديول : oImagePartCls Option Explicit Public WithEvents PicturePart As msforms.Image Private initialY As Single, initialX As Single Private oUForm As Object Public Property Set GetForm(ByVal vNewValue As Object) Set oUForm = vNewValue End Property Private Sub PicturePart_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single) initialX = X: initialY = y PicturePart.ZOrder 0 End Sub Private Sub PicturePart_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single) Dim oCtrl As Control Static oPrevCtrl As Control If Button = 1 Then With PicturePart .Move .Left + (X - initialX), .Top + (y - initialY) For Each oCtrl In oUForm.Controls If TypeName(oCtrl) = "TextBox" Then If Not oPrevCtrl Is Nothing Then oPrevCtrl.Enabled = False oPrevCtrl.BackStyle = fmBackStyleTransparent oPrevCtrl.SpecialEffect = fmSpecialEffectEtched End If If .Left + .Width / 2 > oCtrl.Left And .Left + .Width / 2 < oCtrl.Left + oCtrl.Width _ And .Top + .Height / 2 > oCtrl.Top And .Top + .Height / 2 < oCtrl.Top + oCtrl.Height Then oCtrl.Enabled = True oCtrl.BackStyle = fmBackStyleOpaque oCtrl.SpecialEffect = 6 oCtrl.BackColor = vbWhite Set oPrevCtrl = oCtrl Exit For End If End If Next End With End If End Sub Private Sub PicturePart_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal y As Single) Dim oCtrl As Control For Each oCtrl In oUForm.Controls If TypeName(oCtrl) = "TextBox" Then With PicturePart If .Left + .Width / 2 > oCtrl.Left And .Left + .Width / 2 < oCtrl.Left + oCtrl.Width _ And .Top + .Height / 2 > oCtrl.Top And .Top + .Height / 2 < oCtrl.Top + oCtrl.Height Then .Move oCtrl.Left, oCtrl.Top PicturePart.BorderStyle = fmBorderStyleNone Call oUForm.FlashImagePart(PicturePart, oCtrl) If InStr(1, PicturePart.Tag, oCtrl.Name) Then PicturePart.Tag = PicturePart.Tag & "Success" Else If Right(PicturePart.Tag, 7) = "Success" Then PicturePart.Tag = Mid(PicturePart.Tag, 1, Len(PicturePart.Tag) - 7) End If End If Call oUForm.MsgbBeep Call oUForm.CheckIfSuccess Exit For End If End With End If Next End Sub

السّلام عليكم و رحمة الله و بركاته أستاذي الفاضل ابراهيم أبو ليله .. أرجو أن تضيف لو سمحت هذا الملف ضمن البدائل الخاصّة .. ربّما به تقريب للفكرة .. فائق احتراماتي ابراهيم أبو ليله.rar

بشرى سارة من الذين يعانون من تحديد مسار الملف.. حيث تكمن المشكلة في تحديد اسم المستخدم والمجلد الذي يوجد به الملف.. ولقد جمعت لكم بعث الأمثلة لعل الله ينفع بي وبكم ما تقدموه لهذه الأمة.. إليكم المرفق. specific path.rar

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

السلام عليكم ورحمة الله أخي الكريم، أعتقد أنه يجب وضع الكود المعني في موديول مستقل Standard Module وليس مثل ما فعلت بوضعه في All Open Workbooks ثم ربطه بـ زر Button في أي شيت من الشيتات... والله أعلى وأعلم أخوك بن علية

السلام عليكم الملف شغال بس انت عامله مختفى "hidden" الغى الاخفاء واعمل له حفظ وهو يشتغل تمام لما تفتحه تانى

السّلام عليكم و رحمة الله و بركاته جزاك الله خيرًا و زادها بميزان حسناتك .. كل حرف تكتبه بألف حسنة إن شاء الله .. مجهود كبير تقوم به ..فلترة و تجميع و حفظ .. بارك الله فيك يا غالي يا أبا يوسف وافر احتراماتي

أخي الحبيب وائل عوداً حميداً وبارك الله فيك على الموضوع ممكن تشرح الملف بمزيد من التفصيل إذا توفر لديك الوقت .. وجزاكم الله خير الجزاء

ترقيم حسب الشهر لمعيار معين.rar

ا / بن علية الف شكر و لا اروع و اعمق مما كنت اتخيل بارك الله فيك الشكر ايضا موصول للاستاذ / ياسر للمتابعة و الاهتمام

نموذج بسيط كنت عاملة لطلاب مدرسة نموذج غياب لمنتدى اوفيسنا.rar

السلام عليكم ورحمة الله وبركاته الدرس السادس 8-Loop الحلقات التكراريه وسوف نتناول فى هذه الدرس الاتى لماذا نستخدم الحلقات التكراريه انواع الحلقات التكراريه الخروج من الحلقه التكراريه كيفية استخدام اكثر من حلقه داخل الكود ......................................................................... لماذا نستخدم الحلقات التكراريه انا شخصيا بعتبر الحلقات التكراريه واحده من اهم المواضيع التى يجب معرفتها حينما يتم الدخول الى عالم vba يتم استخدام الحلقات التكراريه لتنفيذ اكثر من امر فى وقت واحد مما يوفر الوقت ولتوضيح ذلك راجع المثال الاتى نفترض اننا لدينا مجموعه من الارقام مثلا 7 ارقام (1-2-3-4-5-6-7) ونريد ادخال هذه الارقم فى السطر الثامن بداية من العمود الخامس اى العمود e فكيف سنقوم بعمل ذلك طبعا الى معندوش فكره عن كيفية استخدام الحلقات التكراريه هيستخدم الكود الاتى Sub enterdata() [e8] = "1" [f8] = "2" [g8] = "3" [h8] = "4" [i8] = "5" [j8] = "6" [k8] = "7" End Sub اى سيقوم بالاشاره الى كل خليه على حده واعطاء كل خليه قيمتها كما هو متضح من الصوره وبالتالى بعد كتابة هذه الكود وتخصيص زر لتنفيذه او بالوقوف داخل الكود بالماوس ثم الضغط على f5 سوف يتم ملئ الخلايا بالبيانات كما فى الصوره دعونا الان نتطرق الى كيفيه تنفيذ ذلك بالحلقات التكراريه انواع الحلقات التكراريه 1- FOR 2- WHILE 3- DO ................................................................................................................................................................................................................................................................ الحلقه الاولى for …next هذه الحلقه تبدأ بكلمة FOR وتنتهى بكلمة NEXT وفيما بين الكلميتن هو ما سوف يتم تنفيذه للتوضيح اكتر For بداية الحلقه = اسم الحلقه To طريقه تنفيذ الحلقه] نهايةالحلقه] [ماسيتم تنفيذه داخل الحلقه] [Exit For] الخروج من الحلقه Next استكمال الحلقه حت النهاية وهنا يجب ان نشير الى ان اى حلقه تكراريه لابد ان يكون لها اسم يعبر عنها وليكن مثلا H ثم يجب ان يكون لها بدايه ولها نهايه وليكن ستبدأ من 1 وتنتهى فى 10 ثم سيكون هناك ما ينفذ داخل الحلقه والمقصود بطريقة تنفيذ الحلقه اى هل سيتم تنفيذها خطوه بخطوه وهذا هو الشائع فى الاستخدام ام كل خطويتن ام كل ثلاث خطوات وهكذا ولتطبيق ذلك سنتعرف على كيفية استخدام الحلقه for فى ادخال البيانات فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 26 بداية من العمود 8 كيف سنقوم بعمل ذلك 1-نعطى الحلقه اسم معين FOR H H 2-نحدد البدايه 8 ونحدد النهاية 11 FOR H =8 TO 11 لاحظ ان عدد الحلقات هنا 4 عباره عن 8و9و10و111 3-ماسيتم تنفيذه Cells(26, h) = h - 7 4-استكمال الحلقه NEXT وبالتالى سيكون شكل الكود كالاتى Sub enterdata_for() For h = 8 To 11 ' h----- متغير تم تعريه على انه يبدأ من 8 وينتهى عند 11 ' اى ان عدد حلقاته هى 4 عباره عن 8ثم9ثم10ثم11 Cells(26, h) = h - 7 ' هنا يتم تنفيذ الكود ' هنا نقول ان الخليه التى تقع فى السطر26 وفى العمود من8الى11 ' مطروحا منه 7 ارقام ليصبح قيمة المتغير تساوى1hتساوى قيمة المتغير ' Cells(26, H)--- الرقم26هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(26, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ على الاعمده من 8الى11 لانها تساوى قيمة المتغير ' h-7 يبدأ من الرقم8وينتهى عند الرقم11 فحينما ينم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تبدأ من الرقم1وتنتهى عند الرقم4 'وبذلك يكون تنفيذ الكود كالاتى ' الخليه فى السطر26وفى العمود5تساوى الرقم1ثم ' الخليه فى السطر26وفى العمود6تساوى الرقم2ثم ' الخليه فى السطر26وفى العمود6تساوى الرقم3ثم ' وهكذا حت نصل الى اخر الحلقه التكراريه اى العمود11 Next ' hتكرار عمل الكود حتى نهاية المتغير ' next---- forاقفال الحلقه التكراريه End Sub ويكون ناتج الكود بهذا الشكل اما اذا اردنا تنفيذ الكود على الخلايا بشكل عمودى بدلا من الخلايا الافقيه بمعنى لو اننا اردنا مثلا تنفيذ نفس الكود على الخلايا من h23 الى h26 اى فى الخلايا h23 و h24 و h25 و h26 كيف سيكون شكل الكود الكود هيكون نفس الكود السابق ولكن ما سيختلف هو اننا سوف نعيد تغير قيمة المتغير h الخاص بالحلقه التكراريه ليصبح من 23 الى 26 ثم نقوم بتغير موضع المتغير h الخاص بالحلقه التكراريه من الصف الى العمود للتوضيح اكثر الفكره هكلها محصوره فى السطرين دول For h = 8 To 11 هنا طبعا قيمة المتغير h الخاص بالحلقه التكراريه من 8 الى 11 احنا عايزين نخليه يبقى من 23 الى 26 يبقى هيكون بالشكل ده For h = 23 To 26 وكمان فى السطر ده Cells(26, h) = h - 7 وطبعا احنا قولنا ان الجزئيه دى Cells(26 تعنى ان الكود سوف ينفذ على السطر 26 والجزئيه دى Cells( , h) تعنى انه هينفذ على العمود h وطبعا h احنا معرفينه على انه من8 الى 11 اى انه سينفذ على العمود 8 ثم العمود 9 ثم العمود10 ثم العمود11 .................................................................................................... طب حنا عايزين ننفذ الكود على العمود h اى العمود رقم 8 يبقى سطر الكود هيكون بالشكل ده Cells( , 8) وعلى السطور من 23 الى 26 وبما اننا عرفنا h على انه من 23 الى 26 يبقى سطر الكود هيصبح بالشكل ده Cells(h, ) وفى النهاية هنلاقى ان سطر الكود بالكامل بالشكل ده Cells(h,8 ) اى ان الكود سينفذ على السطور h الى احنا عرفناها على انها من 23 الى 26 وعلى العمود رقم 8 وبعد كده تأتى الجزئيه دى = h - 7 ولاننا كنا معرفين h يبدأ من الرقم 8 فطرحنا من h الرقم 7 للحصول على الرقم 1 الى هو اول رقم احنا عايزين ندخله فلا او خليه وبما اننا لسه بردو عايزين نخلى الرقم 1 هو اول رقم يتم ادخاله ولكننا قمنا بتغير قيمة المتغير h لتصبح من 23 وللحصول على الرقم 1 يبقى لابد اننا نطرح من المتغير h ما يعطينا الرقم 1 وبالتالى سنجد سطر الكود هيكون كده = h - 22 وفى النهاية سيكون شكل الكود كده Sub enterdata_for1() Dim h As Integer For h = 23 To 26 Cells(h, 8) = h - 22 Next End Sub ويكون ناتج الكود بهذا الشكل الحلقه الثانيه While سوف نتعرف على كيفيه استخدام الحلقه التكراريه While...Wend هذه الحلقه تبدأ بكلمة While وتنتهى بكلمة Wend وفيما بين الكلميتن هو ما سوف يتم تنفيذه للتوضيح اكتر While [ الشرط ] ما يتم تنفيذه Wend نهاية الحلقه فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 38 بداية من العمود 8 كيف سيكون شكل الكود Sub EnterwhileWend() Dim h As Integer ' H--- متغير تم تعريفه على انه رقم صحيح h = 8 ' متغير تم تعريفه على انه يساوى الرقم8----- While h <= 11 ' هنا نقول ان الحلقه التكراريه تكون اقل من الرقم11او تساويه Cells(38, h) = h - 7 ' Cells(38, H)--- الرقم38هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(38, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ بديةمن العمود8 لانها تساوى قيمة المتغير ' h-7 يساوى الرقم8 فحينما يتم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تساوى الرقم1 h = h + 1 'h = h + 1 هنا نقول انه يتم زياده قيمة المتغير بقيمة1صحيح مع كل ' حلقه تكراريه حتى نصل الى الشرط وهو ان يكون اقل من او يساوى11 Wend '-------'نهاية الحلقه While End Sub ويكون ناتج الكود بهذا الشكل الحلقه الثالثه Do تنقسم الى ثلاثة انواع النوع الاول Do While Loop فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 57 بداية من العمود 8 كيف سيكون شكل الكود Sub EnterDoWhile() Dim h As Integer ' H--- متغير تم تعريفه على انه رقم صحيح h = 8 ' متغير تم تعريفه على انه يساوى الرقم8----- Do While h <= 11 ' هنا نقول ان الحلقه التكراريه تكون اقل من الرقم11او تساويه Cells(57, h) = h - 7 ' Cells(57, H)--- الرقم57هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(57, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ بديةمن العمود8 لانها تساوى قيمة المتغير ' h-7 يساوى الرقم8 فحينما يتم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تساوى الرقم1 h = h + 1 'h = h + 1 هنا نقول انه يتم زياده قيمة المتغير بقيمة1صحيح مع كل ' حلقه تكراريه حتى نصل الى الشرط وهو ان يكون اقل من او يساوى11 Loop '-------'نهاية الحلقه Do While End Sub ويكون ناتج الكود بهذا الشكل النوع الثانى Do Loop While فلو اننا نريد ادخال الارقام من1 الى 4 فى السطر 67 بداية من العمود 8 كيف سيكون شكل الكود Sub EnterDo() Dim h As Integer ' H--- متغير تم تعريفه على انه رقم صحيح h = 8 ' متغير تم تعريفه على انه يساوى الرقم8----- Do Cells(67, h) = h - 7 ' Cells(67, H)--- الرقم67هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(67, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ بديةمن العمود8 لانها تساوى قيمة المتغير ' h-7 يساوى الرقم8 فحينما يتم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تساوى الرقم1 h = h + 1 'h = h + 1 هنا نقول انه يتم زياده قيمة المتغير بقيمة1صحيح مع كل ' حلقه تكراريه حتى نصل الى الشرط وهو ان يكون اقل من او يساوى11 Loop While h <= 11 ' هنا نقول ان الحلقه التكراريه تكون اقل من الرقم11او تساويه '-------'نهاية الحلقه Do End Sub ويكون ناتج الكود بهذا الشكل النوع الثالث Do Until Loop فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 77 بداية من العمود 8 كيف سيكون شكل الكود Sub EnterDoUntil() Dim h As Integer ' H--- متغير تم تعريفه على انه رقم صحيح h = 8 ' متغير تم تعريفه على انه يساوى الرقم8----- Do Until h > 11 ' هنا نقول ان الحلقه التكراريه سوف تنفذ حتى الرقم11 Cells(77, h) = h - 7 ' Cells(77, H)--- الرقم77هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(77, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ بديةمن العمود8 لانها تساوى قيمة المتغير ' h-7 يساوى الرقم8 فحينما يتم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تساوى الرقم1 h = h + 1 'h = h + 1 هنا نقول انه يتم زياده قيمة المتغير بقيمة1صحيح مع كل ' حلقه تكراريه حتى نصل الى الشرط وهو ان يكون اقل من او يساوى11 Loop '-------'نهاية الحلقه Do Until End Sub ويكون ناتج الكود بهذا الشكل اتمنى ان اكون قد وفقت فى هذا الدرس انتظروا باقى الدروس تقبلوا تحياتى

السلام عليكم ورحمة الله وبركاته أخي الصقر ما شاء الله بارك الله تم الوصول للنتيجة المطلوبة ولكن أتساءل هل يمكن أن يتم البحث بعد انتهاء الكتابة في الليست بوكس تماماً...أم أنه يبحث عن كل رقم أثناء الكتابة تقبل تحياتي..

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

السلام عليكم ورحمة الله وبركاته الدرس السادس 8-Loop الحلقات التكراريه وسوف نتناول فى هذه الدرس الاتى لماذا نستخدم الحلقات التكراريه انواع الحلقات التكراريه الخروج من الحلقه التكراريه كيفية استخدام اكثر من حلقه داخل الكود ......................................................................... لماذا نستخدم الحلقات التكراريه انا شخصيا بعتبر الحلقات التكراريه واحده من اهم المواضيع التى يجب معرفتها حينما يتم الدخول الى عالم vba يتم استخدام الحلقات التكراريه لتنفيذ اكثر من امر فى وقت واحد مما يوفر الوقت ولتوضيح ذلك راجع المثال الاتى نفترض اننا لدينا مجموعه من الارقام مثلا 7 ارقام (1-2-3-4-5-6-7) ونريد ادخال هذه الارقم فى السطر الثامن بداية من العمود الخامس اى العمود e فكيف سنقوم بعمل ذلك طبعا الى معندوش فكره عن كيفية استخدام الحلقات التكراريه هيستخدم الكود الاتى Sub enterdata() [e8] = "1" [f8] = "2" [g8] = "3" [h8] = "4" [i8] = "5" [j8] = "6" [k8] = "7" End Sub اى سيقوم بالاشاره الى كل خليه على حده واعطاء كل خليه قيمتها كما هو متضح من الصوره وبالتالى بعد كتابة هذه الكود وتخصيص زر لتنفيذه او بالوقوف داخل الكود بالماوس ثم الضغط على f5 سوف يتم ملئ الخلايا بالبيانات كما فى الصوره دعونا الان نتطرق الى كيفيه تنفيذ ذلك بالحلقات التكراريه انواع الحلقات التكراريه 1- FOR 2- WHILE 3- DO ................................................................................................................................................................................................................................................................ الحلقه الاولى for …next هذه الحلقه تبدأ بكلمة FOR وتنتهى بكلمة NEXT وفيما بين الكلميتن هو ما سوف يتم تنفيذه للتوضيح اكتر For بداية الحلقه = اسم الحلقه To طريقه تنفيذ الحلقه] نهايةالحلقه] [ماسيتم تنفيذه داخل الحلقه] [Exit For] الخروج من الحلقه Next استكمال الحلقه حت النهاية وهنا يجب ان نشير الى ان اى حلقه تكراريه لابد ان يكون لها اسم يعبر عنها وليكن مثلا H ثم يجب ان يكون لها بدايه ولها نهايه وليكن ستبدأ من 1 وتنتهى فى 10 ثم سيكون هناك ما ينفذ داخل الحلقه والمقصود بطريقة تنفيذ الحلقه اى هل سيتم تنفيذها خطوه بخطوه وهذا هو الشائع فى الاستخدام ام كل خطويتن ام كل ثلاث خطوات وهكذا ولتطبيق ذلك سنتعرف على كيفية استخدام الحلقه for فى ادخال البيانات فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 26 بداية من العمود 8 كيف سنقوم بعمل ذلك 1-نعطى الحلقه اسم معين FOR H H 2-نحدد البدايه 8 ونحدد النهاية 11 FOR H =8 TO 11 لاحظ ان عدد الحلقات هنا 4 عباره عن 8و9و10و111 3-ماسيتم تنفيذه Cells(26, h) = h - 7 4-استكمال الحلقه NEXT وبالتالى سيكون شكل الكود كالاتى Sub enterdata_for() For h = 8 To 11 ' h----- متغير تم تعريه على انه يبدأ من 8 وينتهى عند 11 ' اى ان عدد حلقاته هى 4 عباره عن 8ثم9ثم10ثم11 Cells(26, h) = h - 7 ' هنا يتم تنفيذ الكود ' هنا نقول ان الخليه التى تقع فى السطر26 وفى العمود من8الى11 ' مطروحا منه 7 ارقام ليصبح قيمة المتغير تساوى1hتساوى قيمة المتغير ' Cells(26, H)--- الرقم26هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(26, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ على الاعمده من 8الى11 لانها تساوى قيمة المتغير ' h-7 يبدأ من الرقم8وينتهى عند الرقم11 فحينما ينم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تبدأ من الرقم1وتنتهى عند الرقم4 'وبذلك يكون تنفيذ الكود كالاتى ' الخليه فى السطر26وفى العمود5تساوى الرقم1ثم ' الخليه فى السطر26وفى العمود6تساوى الرقم2ثم ' الخليه فى السطر26وفى العمود6تساوى الرقم3ثم ' وهكذا حت نصل الى اخر الحلقه التكراريه اى العمود11 Next ' hتكرار عمل الكود حتى نهاية المتغير ' next---- forاقفال الحلقه التكراريه End Sub ويكون ناتج الكود بهذا الشكل اما اذا اردنا تنفيذ الكود على الخلايا بشكل عمودى بدلا من الخلايا الافقيه بمعنى لو اننا اردنا مثلا تنفيذ نفس الكود على الخلايا من h23 الى h26 اى فى الخلايا h23 و h24 و h25 و h26 كيف سيكون شكل الكود الكود هيكون نفس الكود السابق ولكن ما سيختلف هو اننا سوف نعيد تغير قيمة المتغير h الخاص بالحلقه التكراريه ليصبح من 23 الى 26 ثم نقوم بتغير موضع المتغير h الخاص بالحلقه التكراريه من الصف الى العمود للتوضيح اكثر الفكره هكلها محصوره فى السطرين دول For h = 8 To 11 هنا طبعا قيمة المتغير h الخاص بالحلقه التكراريه من 8 الى 11 احنا عايزين نخليه يبقى من 23 الى 26 يبقى هيكون بالشكل ده For h = 23 To 26 وكمان فى السطر ده Cells(26, h) = h - 7 وطبعا احنا قولنا ان الجزئيه دى Cells(26 تعنى ان الكود سوف ينفذ على السطر 26 والجزئيه دى Cells( , h) تعنى انه هينفذ على العمود h وطبعا h احنا معرفينه على انه من8 الى 11 اى انه سينفذ على العمود 8 ثم العمود 9 ثم العمود10 ثم العمود11 .................................................................................................... طب حنا عايزين ننفذ الكود على العمود h اى العمود رقم 8 يبقى سطر الكود هيكون بالشكل ده Cells( , 8) وعلى السطور من 23 الى 26 وبما اننا عرفنا h على انه من 23 الى 26 يبقى سطر الكود هيصبح بالشكل ده Cells(h, ) وفى النهاية هنلاقى ان سطر الكود بالكامل بالشكل ده Cells(h,8 ) اى ان الكود سينفذ على السطور h الى احنا عرفناها على انها من 23 الى 26 وعلى العمود رقم 8 وبعد كده تأتى الجزئيه دى = h - 7 ولاننا كنا معرفين h يبدأ من الرقم 8 فطرحنا من h الرقم 7 للحصول على الرقم 1 الى هو اول رقم احنا عايزين ندخله فلا او خليه وبما اننا لسه بردو عايزين نخلى الرقم 1 هو اول رقم يتم ادخاله ولكننا قمنا بتغير قيمة المتغير h لتصبح من 23 وللحصول على الرقم 1 يبقى لابد اننا نطرح من المتغير h ما يعطينا الرقم 1 وبالتالى سنجد سطر الكود هيكون كده = h - 22 وفى النهاية سيكون شكل الكود كده Sub enterdata_for1() Dim h As Integer For h = 23 To 26 Cells(h, 8) = h - 22 Next End Sub ويكون ناتج الكود بهذا الشكل اتمنى ان اكون قد وفقت فى هذا الدرس انتظروا باقى الدروس تقبلوا تحياتى

أستادي الفاضل أنس جربت على عجالة الملف على أوفيس 32/2010 ويندوز 64 بت في احدى السيبيرات و بالفعل الملف لم يعمل كما تفضلت ولم تتغير الشفافية للأسف بدون توفري على جهاز فيه الويندوز 64 لن أتمكن بسهولة من معرفة سبب المشكلة .. احدى مشاكل برمجة ال API هي تعدد اصدارات الاوفيس و الويندوز .. ان شاء الله قريبا سأتوفر على جهاز جديد يعمل على الويندوز 64 و سأقوم بتعديل كل الكودات

بارك الله فيك أستاذي وحبيبي ياسر على التوجيهات القيمة التي إن دلت على شيء فإنما تدل على موجه نبيل ذو قيم رفيعة وقد نزلت عند طلبك ومن أجل راحة بال أستاذي فأنا اليوم اسمي صلاح الدين المصلح بدل salah15salah ..أصلح الله أمورنا جميعا وهدانا إلى صراطه المستقيم وعلمنا ما ينفعنا في ديننا ودنيانا إنه ولي ذلك والقادر عليه .

تم بفضل الله شاكر مرورك ومساعدتك اخي صلاح المصري

جرب المرفق عمل بطاقة للموظف والمدرسة1.rar

وعليكم السلام أخي للأسف ، هذه مشكلة في الاكسس ، في النموذج المستمر ، عندما يأخذ مربع السرد والتحرير قيمته استنادا على حقل آخر الحل هو: اعمل نسخة من SQL استعلام مربع سرد وتحرير حقل الوحدة ، اعمل استعلام جديد ، انا اسميته qry_INV100_Unite ، اعمل النموذج المستمر frm_INV100_Unite ، اللي يأخذ بياناته من الاستعلام qry_INV100_Unite ، في النموذج الفرعي INV100 ، احذف المعيار من حقل الوحدة ، في الحدث "بعد التحديث" للحقل "رمز المادة" ، افتح النموذج frm_INV100_Unite (والذي سيكون مصفى حسب "رمز المادة" ، اضغط على زر Ok للمادة التي تريدها ، وسترى ان القيمة انتقلت لحقل الوحدة في النموذج الفرعي INV100 ، وسيغلق النموذج frm_INV100_Unite سهله هه جعفر 220.البرنامج.accdb.zip

تسلم الايادى اللى بتعمل برمجه بتنادى ... تحيه للصعايده الجدعان واولهم الاستاذ مختار

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

السلام عليكم اخواني الموضوع جميل ويحتمل افكار كتير وكذلك يمكن الدمج بين اكثر من فكرة وانا اخترت هذا الاخير فقمت بادماج عمل اخي سلطان مختار مع ادخال التكست بوكس في هذا العمل والتغيير في خاصية PasswordChar وهذا يحل موضوع حفظ الباسورد في مكان اخر ارجو التجربة اخباري النتيجة تحياتي Passwords1.rar

السلام عليكم ورحمة الله قمت بتبديل الدالة VLOOKUP بدالة أخرى OFFSET مع الدالة MATCH مع تعديلات على تنسيقات شيتات الملف... بن علية خط سير شهرى3.rar

السلام عليكم ورحمة الله وبركاته استجابة لطلب أخي وحبيبي في الله ياسر خليل أبو البراء..وفقه الله إلى كل خير المتعلق بوضع المرفقات ضمن مشاركة واحدة أقترح تجميع كل المرفقات في مشاركة واحدة حتى يسهل على من حضر الموضوع متأخراً أن يلملم المرفقات مرة واحدة بلا جهد وبلا مشقة المصفوفات في الإكسيل جزء1 المصفوفات في الإكسيل جزء2 سلسلة علمني كيف أصطاد1 شرح مفصل للدالة countif دراسة متأنية لفورم صرف المعلومات المهمة عن الـ VBA

أخي الكريم محمد الألفي إليك الملف التالي عله يكون المطلوب راجع المخرجات بشكل جيد ترحيل حسب الترتيب التصاعدى للتاريخ بشرط الفتره المحدده .rar

الرجاء إرفاق الملف للاطلاع عليه وحل المشكلة

اشكرك اخوي محمد على المساعدة وبالفعل هذا هو المطلوب وجزاك الله خير .

السلام عليكم ورحمة الله أثناء التنقل بين المنتديات وقعت على كود لعملية حساب المخزون أود من الإخوة المباركين المساعدة فى إدارج الكود فى ملف إكسيل لفهمه ومحاولة تطبيقه الرابط وبه صورة لشيت الاكسيل الذى طبق عليه الكود http://www.mrexcel.com/forum/excel-questions/167756-inventory-fifo-lifo-average-cost.html الكود الأول Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then FIFO End With End Sub الكود الثانى Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then LIFO End With End Sub الكود الثالث Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If Not IsNumeric(.Value) Then Exit Sub If Not Intersect(.Cells(1, 1), Range("e:g")) Is Nothing And _ .Row > 6 Then AVR_COST End With End Sub كود المعادلات البلتى إن Sub FIFO() Dim a As Variant, Cost As Double, sumIn As Double, sumOut As Double, _ i As Long, ii As Long, n As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("FIFO") .Range("i7", .Cells(Rows.Count, "i").End(xlUp)).ClearContents a = .Range("e7", .Cells(Rows.Count, "g").End(xlUp)).Resize(, 5).Value n = 1 For i = LBound(a, 1) To UBound(a, 1) If Not IsEmpty(a(i, 3)) Then sumOut = a(i, 3) For ii = n To i - 1 If Not IsEmpty(a(ii, 2)) Then sumIn = sumIn + a(ii, 2) If sumIn > sumOut Then Exit For Else Cost = Cost + a(ii, 1) * a(ii, 2) a(ii, 2) = Empty End If End If Next If sumIn - sumOut > 0 Then Cost = (Cost + (a(ii, 1) * (a(ii, 2) - (sumIn - sumOut)))) / sumOut a(ii, 2) = sumIn - sumOut Else Cost = Cost / sumOut End If a(i, 5) = Cost sumIn = 0: sumOut = 0: Cost = 0: n = ii End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, 0, 5) Erase a End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub Sub LIFO() Dim a As Variant, Cost As Double, sumIn As Double, sumOut As Double, _ i As Long, ii As Long With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("LIFO") .Range("i7", .Cells(Rows.Count, "i").End(xlUp)).ClearContents a = .Range("e7", .Cells(Rows.Count, "g").End(xlUp)).Resize(, 5).Value For i = LBound(a, 1) To UBound(a, 1) If Not IsEmpty(a(i, 3)) Then sumOut = a(i, 3) For ii = i - 1 To 1 Step -1 If Not IsEmpty(a(ii, 2)) Then sumIn = sumIn + a(ii, 2) If sumIn > sumOut Then Exit For Else Cost = Cost + a(ii, 1) * a(ii, 2) a(ii, 2) = Empty End If End If Next If sumIn - sumOut > 0 Then Cost = (Cost + (a(ii, 1) * (a(ii, 2) - (sumIn - sumOut)))) / sumOut a(ii, 2) = sumIn - sumOut Else Cost = Cost / sumOut End If a(i, 5) = Cost sumIn = 0: sumOut = 0: Cost = 0: n = ii End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, , 5) Erase a End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Erase a End Sub Sub AVR_COST() Dim a, i As Long, Bal As Double, Debit As Double Dim AVcost As Double With Application .Calculation = xlCalculationManual .EnableEvents = False End With With Sheets("AVR COST") a = .Range("e7", .Cells(.Rows.Count, "g").End(xlUp)).Resize(, 3).Value .Range("i7", .Cells(.Rows.Count, "i").End(xlUp)).ClearContents ReDim Preserve a(1 To UBound(a, 1), 1 To 4) For i = LBound(a, 1) To UBound(a, 1) If a(i, 2) > 0 Then Bal = Bal + a(i, 2) Debit = Debit + a(i, 1) * a(i, 2) AVcost = Debit / Bal ElseIf a(i, 3) > 0 Then a(i, 4) = AVcost Debit = Debit - a(i, 3) * AVcost Bal = Bal - a(i, 3) End If Next .Range("i7").Resize(UBound(a, 1)) = Application.Index(a, 0, 4) Erase a End With With Application .Calculation = xlCalculationAutomatic .EnableEvents = True End With End Sub الرجاء الإهتمام لإثراء الفكرة وتطبيقها

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

اخى الفاضل تفضل تم الغاء تظليل البيانات وعدم الترحيل اذا كانت بعض الخلايا فارغة وهي رقم الموظف وكود الدورة وبدايتها تحياتي نموذج ترشيحات العاملين للبرامج التدريبي4.rar

السلام عليكم تم بحمد الله الانتهاء من الحلقة الرابعة عشر http://www.officena.net/ib/index.php?showtopic=57094&page=11#entry378087 دمتم بود

السلام عليكم ورحمة الله وبركاته استاذي الكريم الف شكر لك لردك ومساعدتك الكود يعمل على جميع الاوراق ولا يمسح ماتم ترحيله مسبق لكن اذا تكرمت علي اريد فقط ترحيل الصف الاخير من الورقة والكود يقوم بترحيل كامل البيانات داخل الصفحة المتطابقة داخل الخلية k والمطلوب فقط ترحيل السطر الاخير واذا كان في الامكان الا يقوم بترحيل السطر الاخير اذا كان مرحل سابقا الى مشروع تم ترحيله عليه مثلا تم ترحيل السطر الاخير من مشروع الوليد الى مشروع 147 وبعدها لم يتم اضافة سطر اخر في مشروع الوليد وتم الضغط على كلمة ترحيل لا يسمح بتنفيذ عملية الترحيل السطر الاخير والموجه الى مشروع 147 لان هذه البيانات موجودة مسبقا في نفس المشروع ويسمح بترحيلها اذا تم تغير اسم المشروع المرسل اليه مثلا الى 146 ارجو ان اكون وضحت طلبي وارجو مساعدتي ولك جزيل الشكر مني وعليكم السلامورحمة الله وبركاته استخدم فقط هذا الكود Option Explicit Sub kh_Trheel() Dim NamSheet As String Dim Last As Long ''''''''''''''''''''''' On Error GoTo kh_ExT Last = Cells(Rows.Count, "A").End(xlUp).Row NamSheet = CStr(Cells(Last, "K")) If Not IsError(Evaluate("'" & NamSheet & "'!A1")) Then With Sheets(NamSheet) If CStr(.Cells(Rows.Count, "K").End(xlUp)) = NamSheet Then MsgBox "مكرر": Exit Sub Else Cells(Last, "A").Resize(1, 11).Copy .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) End If End With End If ''''''''''''''''''''''' ''''''''''''''''''''''' kh_ExT: If Err Then MsgBox "Error Number : " & Err.Number Err.Clear Else MsgBox "الحمد لله تم الترحيل" End If ''''''''''''''''''''''' End Sub المرفق 2003 تحياتي ترحيل صف الى ورقة معينة حسب خلية معينة.rar

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

أخي العزيز، تم عمل كود يقوم بترحيل ما في النموذج من ورقة "الرئيسي" إلى ورقة "الكل" ثم إلى الورقة المحددة بالخلية F2 (مرسل إلى) وبعد عملية الترحيل يقوم الكود بتفريغ كل البيانات في النموذج... تم حفظ الملف بصيغة xlsb بدلا من صيغة xlsm... أرجو أن يعجبك الملف وكل هذه الإضافات.... المرفق: قائمة الشحن.rar

السلام عليكم ما الخطأ فى هذا الكود و شكرا بيانات اعدادى.rar

هذا تجميع لأهم الدروس والمواضيع المميزة بالمنتدى ضم روابط المواضيع المثبتة من أعمال معلمينا الفضلاء ومبدعينا في صفحة واحدة .. وذلك من باب التجديد والتغيير وإعطاء مساحة اكبر للمواضيع المتجددة .. *********************************************************************** أولا : توجيهات للأعضاء الجدد في المنتدى ثانيا : طلب من جميع الخبراء وجميع الاعضاء النشطاء الذين يتصدون للحلول وإجابة السائلين *********************************************************************** القسم الأول : الجداول والاستعلامات: الاستعلام الجدولي والمعايير تعامل-مع-ملفات-الاكسل-عن-طريق-الاستعلام-،-وبدون-كود-،-عن-طريق-استعلام-مسقط/ سِحر-جداول-الاكسس-في-تسجيل-الوقائع-عن-طريق-tables-data-macro/ القسم الثاني : النماذج: شرح أداة WebBrowser 1 2 شاشة انتظر من فضلك !! | سلسلة مهارات في أكسس | 06 | توسيط النماذج داخل النافذة أو الإطار طريقة إبداعية لتغيير خلفيات جميع النماذج إعادة تسمية العناصر الكثيرة دفعة واحدة في النموذج بأسماء متسلسلة مثل : ( Box2 , Box1 , ... ) ⭐ كيف تغير اللغة في برامجك ⭐ ✨💻 صفحة رئيسية متطورة بقائمة جانبية وأزرار فرعية ⭐ التحكم الكامل فى واجهة اكسس ( تصغير بجوار الساعة - توسيط - اخفاء - تغيير أيقونة شعار أكسس ) فصل الارقام مثل (الرقم القومى/الهوية) - الرقم التآمينى .. الخ القسم الثالث : التقارير: مسقط التقارير او صانع التقارير انشاء شريط طباعة للتقرير القسم الرابع : الماكرو والوحدات النمطية VBA: إنشاء دروس VBA أكسس كشكول VBA ترجمة النصوص وتحويلها إلى صوت في vba باستخدام جوجل دالة لحساب أيام الحضور والغياب .. وفكرة عد القيم النصية في حقول السجل الواحد :: اجعل برنامجك يعمل على النواتين 32بت و 64بت اجعل برنامجك يعمل على النواتين 32بت و 64بت _ طريقة ثانية دوال عامة وافكار مختلفة ( بداية مهمه لتسجيل الاخطاء) دوال عامة وافكار مختلفة ( FileDialog ) دوال عامة وافكار مختلفة ( بداية مهمه لتسجيل الاخطاء) دوال عامة وافكار مختلفة ( FileDialog ) (ImmediateWindowHelper) تفقيط عام متعدد : تحويل الارقام وقيمة ارقام العملة أو ( عملات متعددة ) الى نص مع التفقيط باللغة العربية ولغة اخرى منتقى التواريخ "Date pickers" إصدار-جديد-فكرة-بسيطة-لطباعة-أو-إظهار-رسائل-بنتائج-الأكواد-مع-إمكانية-التفعيل-والتعطيل/? التحكم-الكامل-فى-واجهة-اكسس-تصغير-بجوار-الساعة-توسيط-اخفاء-تغيير-أيقونة-شعار-أكسس/ متعقب-التغييرات-الذكي-2024 اداة البحث المتعددة الوظائف مُطَهَّرُ النُّصُوصِ الْعَرَبِيَّةِ ( ازالة المسافات الزائدة و التشكيل و تنظيف النصوص - و توحيد الاشكال المختلفة للأحرف ) مُطَهَّرُ النُّصُوصِ الْعَرَبِيَّةِ الاصدار 2 ( ازالة المسافات الزائدة و التشكيل و تنظيف النصوص - و توحيد الاشكال المختلفة للأحرف ) أتمتة عمليات الضغط وفك الضغط للملفات و المجلدات (WinRAR / Seven Zip ) تنفيذ الأوامر والملفات في بيئة Windows مع تحكم دقيق في العمليات القسم الخامس : قواعد البيانات SQL وما يتعلق بها: أكسس و اسكيوال سيرفر Access with Sql Server الأكسس و SQL جُمل SQL مشاركة قاعدة البيانات على الانترنت بواسطة SQL Server [تطبيق] تحويل قاعدة بيانات اكسس الى SQL Server (الجزء الاول _ الجزء الخامس) ربط الاكسيس ب php القسم السادس : البرامج والأدوات والإضافات: إدارة الجداول المرتبطة ، أداة وشروحات نظام مراسلة واشعارات شبيه بالفيس بوك معالج بحث وتصفح مسقط التصفح كارنيهات باستخدام باركود ماتركس - QR code محاكاة برنامج واتساب بالاكسس .. هدية لاوفيسنا القائمة المختصرة - Shortcut menu ارسال رسائل whatsapp (وتساب) بدون حفظ الرقم رسائل whatsapp (وتساب) في اكسس رسائل whatsapp (وتساب) بدون حفظ الرقم ( الكاتب الذكي لدوال المجال في أكسس Dloockup, DCount, DMax, DMin, Dfirst, DLast , DSum, DAvg) ⭐⭐(( مكتبة الأكواد الخاصة )) :: الإصدار الثاني 2.0 ⭐⭐ ، /// ، مكتبة الأكواد الخاصة | سلسلة هدايا الأكسس | 04 | 🎁 - 📟 آلة حاسبة 📟 - هدية مميزة مفتوحة المصدر 🎁 🖌️✏️👨😉🧑‍💻 ... برنامج دردشة بين المستخدمين على الشبكة ... 👨‍💻🧑‍💻✍️😊✏️🖊️ 🎁 :: هديتي لكم :: 🌷📨 >> برنامج مرسال الواتسأب - مع المرفقات - << ✉️ 🙂🌷💌 🎁 :: مرسال الواتسأب :: 📨 :: الإصدار الثاني 2.0 :: مطور :: 🧬🏹 🎁 هدايا الأكسس ✨ | 03| زاد المثابر للحصول على أسماء العناصر في أكسس | أداة رائعة للمطورين 🧛🏻‍♂️ [الاصدار الثاني] ارسال رسائل جماعية لعدد x من المستخدمين على الواتس اب في الاكسس هدية: برنامج تصدير بيانات من جداول/استعلامات اكسس الى اكسل ، 32بت و 64بت هداء لكم برنامج بسيط للديون والسداد 🟢 واتساب ويب web.watsapp 🟢 هدية : تصدير كائنات دفعة واحدة الى قاعدة أخرى أو حسب إختيارك 🧮 الكاتب الذكي لدوال المجال |::| 📜 نسخة مطورة ومحدثة |::| 😊 الإصدار الثاني 2.0 ⭐ كيف تغير اللغة في برامجك ⭐ اختيار صورة من (Shell32.Dll) وحفظها بمجلد وبجدول وعرضها طريقة ابداعية للتحديث من خلال الانترنت تغيير لغة النظام في Unicode القسم السابع : الأفكار والنصائح والتوجيهات: مواضيع مهمة .. قراءة وتفكيك بيانات الحقل الى حقول تطبيقات وأفكار وتلميحات تخفيض امان windows وتسجيل المكتبات عند تنصيب البرامج هام لمطورى ومصممى قواعد البيانات إنتبهوا حتى لا تواجهوا مشاكل مع العملاء خلاصة الأقوال .. حول مسائل الحماية 🔒🔑💪🏻 القسم الثامن : مواضيع متنوعة: ملف للبحث عن المواضيع في هذا المنتدى بعض المواضيع المتميزة والمهمة ( 8 ) الحماية برقم القرص الصلب والمعالج واللوحة الأم شرح أكسس 2003 - 2007 - 2010 - 2013 ( صوت وصورة ومرفقات ) رفع نسخة احتياطية على السحابة (google drive) ::💡 أفكار وفوائد 💡:: أسهل طريقة لعمل مربعات صح ✔ أو خطأ ✘ بالحجم واللون الذي تريده ❌☑️✔️✅❎ ⭐⭐ طريقة إبداعية لتحديث نسخة الواجهات FE 🖥️ لدى المستخدمين بدون برامج أو أدوات خارجية 😊👌⭐⭐ رمز الاستجابه السريع QR CODE حسب متطلبات هيئة الضرائب السعودية: ------------------------------------------------------ 1. https://www.officena.net/ib/topic/112126-موضوع-مهم-للنقاش-ماهو-مستقبل-الاكسس-بعد-تطبيق-المرحله-الثانيه-للفاتوره-الاكترونيه/ 2. الموضوع والمرفقات النهائية لرمز الاستجابه السريع QR CODE حسب متطلبات هيئة الضرائب السعودية 3. https://www.officena.net/ib/topic/112589-مكتبة-الموقع-الفاتورة-السعودية-المبسطة/ --------------------------------------------------------------------------------------------------------------------------------------------------------------- القسم التاسع : الدروس والشروحات والمشاريع : طريقة /اضافة صوت للاكسس مع التحكم فى (الايقاف/التشغيل) للصوت تصميم قاعدة بيانات احترافيه لإدارة يوميات وشئون العاملين

اخي الشهابي تم إنشاء موضوع جديد للفائدة ممكن ذلك تفضل المرفق (تم عمل قائمة منسدلة متجدد ومهما اضفت من أوراق عمل ستجدها تلقائياً في القائمة المنسدلة) جرب واعلمني بالنتيجة ابواحمد ترحيل الى اوراق مختارة.rar

السلام عليكم اكرر ان لم يكن المطلوب بلغنى لا تنسى فتح المرفقين معاً Dim MyRNG As Range Set MyRNG = Selection If MyRNG.Interior.ColorIndex = 6 Then MsgBox "áÞÏ Êã ÊÑÍíá ÇáäØÇÞ" & vbCrLf & MyRNG.Address(0, 0) & vbCrLf & "ãÓÈÞÇð" Exit Sub End If For A = 1 To MyRNG.Rows.Count D = Workbooks("ãÍá22").Sheets(1).Cells(1000, 1).End(xlUp).Row + 1 For B = 1 To MyRNG.Columns.Count Workbooks("ãÍá22").Sheets(1).Cells(D, B) = MyRNG.Cells(A, B) Next B Next A MyRNG.Interior.ColorIndex = 6 محل11.rar