دروب مبرمج

ما شاء الله لا قوة الا بالله شغل احترافي و تصميم جميل و مبدع

عندك مشكلة في اسم الصفحات في الاكسل الصفحة Feuil1006 فيها مسافة نهاية الجملة هذا فقط للعلم مرفق التعديل تفضل Excel_Bilal_Yamen.zip

الموضوع ممتع و شيق تفضل هذه الفكرة الخطوة الأولى: تجهيز النموذج (Form) أنشئ نموذجاً جديداً (Form) أضف 9 أزرار أمر (Command Buttons) وقم بتسميتها برمجياً كالتالي: btn1, btn2, btn3 (للصف الأول) btn4, btn5, btn6 (للصف الثاني) btn7, btn8, btn9 (للصف الثالث) أضف زر عاشر باسم btnReset لإعادة اللعبة. أضف "تسمية" (Label) باسم lblStatus لعرض حالة اللعبة (دور من؟ أو من الفائز؟). الكود البرمجي Option Compare Database Option Explicit ' متغيرات عامة للتحكم في حالة اللعبة Dim GameOver As Boolean ' عند تحميل النموذج Private Sub Form_Load() ResetGame End Sub ' زر إعادة تشغيل اللعبة Private Sub btnReset_Click() ResetGame End Sub ' الإجراء الرئيسي عند ضغط اللاعب على أي مربع Private Sub PlayMove(btn As CommandButton) ' التأكد أن المربع فارغ وأن اللعبة لم تنتهِ If btn.Caption = "" And Not GameOver Then btn.Caption = "X" btn.ForeColor = RGB(0, 0, 150) ' لون أزرق لعلامة اللاعب If CheckWinner("X") Then lblStatus.Caption = "مبروك! لقد فزت." lblStatus.ForeColor = RGB(0, 150, 0) ' لون أخضر عند الفوز Beep ' صوت تنبيه GameOver = True Else ' إذا لم يفز اللاعب، يأتي دور النظام CPUMove End If End If End Sub ' منطق ذكاء النظام (الكمبيوتر) Private Sub CPUMove() If GameOver Then Exit Sub Dim moveIndex As Integer ' 1. محاولة الفوز (الهجوم) moveIndex = FindBestMove("O") ' 2. سد الطريق على اللاعب (الدفاع) If moveIndex = 0 Then moveIndex = FindBestMove("X") ' 3. محاولة السيطرة على المركز (الخانة رقم 5) If moveIndex = 0 And Me.btn5.Caption = "" Then moveIndex = 5 ' 4. اختيار أول خانة متاحة إذا فشلت الاستراتيجيات أعلاه If moveIndex = 0 Then Dim i As Integer For i = 1 To 9 If Me.Controls("btn" & i).Caption = "" Then moveIndex = i Exit For End If Next i End If ' تنفيذ حركة النظام If moveIndex > 0 Then With Me.Controls("btn" & moveIndex) .Caption = "O" .ForeColor = RGB(200, 0, 0) ' لون أحمر لعلامة النظام End With ' التحقق هل فاز النظام؟ If CheckWinner("O") Then lblStatus.Caption = "للأسف! فاز النظام." lblStatus.ForeColor = vbRed ' لون أحمر للنص عند الخسارة Beep GameOver = True End If End If ' التحقق من حالة التعادل (إذا امتلأت الخانات ولم يفز أحد) If Not GameOver Then Dim IsDraw As Boolean: IsDraw = True Dim j As Integer For j = 1 To 9 If Me.Controls("btn" & j).Caption = "" Then IsDraw = False: Exit For Next j If IsDraw Then lblStatus.Caption = "تعادل!" lblStatus.ForeColor = vbBlack Beep GameOver = True End If End If End Sub ' دالة ذكية للبحث عن أفضل حركة (فوز أو دفاع) Private Function FindBestMove(PlayerSign As String) As Integer Dim WinPatterns As Variant Dim i As Integer, count As Integer, emptyPos As Integer Dim pos() As String ' جميع احتمالات الفوز الممكنة WinPatterns = Array("1,2,3", "4,5,6", "7,8,9", "1,4,7", "2,5,8", "3,6,9", "1,5,9", "3,5,7") For i = 0 To 7 pos = Split(WinPatterns(i), ",") count = 0 emptyPos = 0 Dim j As Integer For j = 0 To 2 If Me.Controls("btn" & pos(j)).Caption = PlayerSign Then count = count + 1 ElseIf Me.Controls("btn" & pos(j)).Caption = "" Then emptyPos = CInt(pos(j)) End If Next j ' إذا وجد خانتين لنفس اللاعب والثالثة فارغة، يعيد رقم الخانة الفارغة If count = 2 And emptyPos <> 0 Then FindBestMove = emptyPos Exit Function End If Next i FindBestMove = 0 End Function ' دالة التحقق من الفوز Private Function CheckWinner(Player As String) As Boolean Dim WinPatterns As Variant Dim i As Integer Dim pos() As String WinPatterns = Array("1,2,3", "4,5,6", "7,8,9", "1,4,7", "2,5,8", "3,6,9", "1,5,9", "3,5,7") For i = 0 To 7 pos = Split(WinPatterns(i), ",") If Me.Controls("btn" & pos(0)).Caption = Player And _ Me.Controls("btn" & pos(1)).Caption = Player And _ Me.Controls("btn" & pos(2)).Caption = Player Then CheckWinner = True Exit Function End If Next i CheckWinner = False End Function ' إعادة ضبط اللعبة للحالة الأصلية Private Sub ResetGame() Dim i As Integer For i = 1 To 9 Me.Controls("btn" & i).Caption = "" Me.Controls("btn" & i).ForeColor = vbBlack Next i GameOver = False lblStatus.Caption = "دورك الآن (X)" lblStatus.ForeColor = vbBlack End Sub ' ربط أحداث النقر للأزرار (Events) Private Sub btn1_Click(): PlayMove btn1: End Sub Private Sub btn2_Click(): PlayMove btn2: End Sub Private Sub btn3_Click(): PlayMove btn3: End Sub Private Sub btn4_Click(): PlayMove btn4: End Sub Private Sub btn5_Click(): PlayMove btn5: End Sub Private Sub btn6_Click(): PlayMove btn6: End Sub Private Sub btn7_Click(): PlayMove btn7: End Sub Private Sub btn8_Click(): PlayMove btn8: End Sub Private Sub btn9_Click(): PlayMove btn9: End Sub مرفق مثال على ذلك اكس او.accdb

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

تفضل التعديل Lab5.zip

تفضل التعديل تم اصلاح حذف الملفات تم اصلاح حذف المجلد في حال كان فارغ Lab4.zip

تفضل التعديل LAB33.zip

تفضل التعديل JO.accdb

الافضل اخفي الفورم مرفق التعديل Control_Up_bar_Form_On_Ms_Access_V1.accdbControl_Up_bar_Form_On_Ms_Access_V1.zip

تفضل هذه بعض الاكواد قد تجد بها ضالتك Dim conn As ADODB.Connection Dim rs As ADODB.Recordset Dim strConnString As String strConnString = "Provider=SQLOLEDB;Data Source=Server_Name;Persist Security Info=True;User ID=Your_UserName;Password=Your_Password;" Set conn = New ADODB.Connection conn.Open strConnString Set rs = conn.Execute("SELECT * FROM TabolName") If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) TextBox1= rs.Fields(0).Value rs.MoveNext Wend End If rs.Close Set rs = Nothing مع اضافة المكتبة

اخي العزيز تفضل التعديل JO.accdb

في البداية لا يجب حفظ المسار كامل في قاعدة البيانات و مع ذلك هذه ليست مشكلة سوف نقوم بالإعلان عن ثلاث متغييرات لغرض تخزين اسم المجلد و مسار الملف Dim strPath As String, fileName As String, sFile As String و هنا سنقوم بإستخلاص اسم المجلد لكل مسار في قاعدة البيانات strPath = DLookup("[Attachment_Path]", "[tbl_AttachmentList]", "[Attachment_NO]=" & MyList.Column(0)) و هنا سنقوم بإستخراج اسم الملف من المسار المخزن في قاعدة البيانات fileName = Right$(strPath, Len(strPath) - InStrRev(strPath, "\")) و الآن نقوم بجمع النتائج اعلاه في مسار واحد sFile = CurrentProject.Path & "\MY_Files\" & P_NAMES.Column(1) & "\" & fileName و الآن سنقوم بإضافة المسار الجديد للمستعرض [Forms]![Attacheds]![Show_Files]![MY_PDF].ControlSource = "=""" & sFile & """" و النتيجة تفضل التعديل LAB2.zip

تفضل هذا التعديل البسيط Database4.zip

تفضل هذا التعديل البسيط البحث وتعديل درجات8.zip

تفضل هذه الفكرة فكرة قوائم.zip