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

السلام عليكم 🙂 في الكثير من الاحيان لما نكون في وضع التصميم ، في النموذج او التقرير ، نتمنى لو انه بإمكاننا تكبير الشاشة حتى نرى تفاصل الكائنات ونضعها بجوار بعضها بدقة ، ولكن للأسف الاكسس لا يقدم لنا هذه الخاصية (مثل الاكسل والبوربوينت مثلا) 🙂 في الواقع الوندوز يقدم لنا هذه الخدمة ، ولكن كبرنامج مستقل 🙂 يمكنك استخدام برنامج التكبير بطريقة مستقلة ، بإستخدام ازرار الكيبورد: 1. لإغلاق البرنامج ، زر الوندوز + Esc 2. لتكبير الشاشة ، وتكون ثابته ، زر الوندوز + Alt + F 3. لتكبير الشاشة كمكبر يدوي ، زر الوندوز + Alt + L . وهذه هي الاعدادات التي استعملها انا : . والآن اليكم هذه الطريقة في برنامج الاكسس (يمكننا استعمال اختصارات الوندوز اعلاها في عملنا كذلك) : نموذج به نوعين من تكبير الشاشة ، تستعمل الطريقة التي تفضلها لوضعك 🙂 . الكود هو: Private Sub btn_Zoom_Click() 'open/close the magnify glass If Me.btn_Zoom = -1 Then 'turn ON the magnifying glass 'Shell "cmd /c C:\Windows\System32\Magnify.exe /lens", vbHide Shell "cmd /c C:\Windows\System32\Magnify.exe /fullscreen", vbHide Else 'manually close it: ' Win key & Esc key 'call the Function to kill the magnifying glass process Call WMI_KillProcesse("Magnify.exe") End If End Sub Private Sub btn_Zoom_lens_Click() 'open/close the magnify glass If Me.btn_Zoom_lens = -1 Then 'turn ON the magnifying glass Shell "cmd /c C:\Windows\System32\Magnify.exe /lens", vbHide 'Shell "cmd /c C:\Windows\System32\Magnify.exe /fullscreen", vbHide Else 'manually close it: ' Win key & Esc key 'call the Function to kill the magnifying glass process Call WMI_KillProcesse("Magnify.exe") End If End Sub . واما كود اغلاق برنامج التكبير ، اي يوقف تشغيله من الكمبيوتر: '--------------------------------------------------------------------------------------- ' Procedure : WMI_KillProcesse ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Forcibly kill all the instances of a specified process ' Copyright : The following is release as Attribution-ShareAlike 4.0 International ' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/ ' Req'd Refs: Uses Late Binding, so none required ' ' Input Variables: ' ~~~~~~~~~~~~~~~~ ' sProcessName : Name of the process to kill ' sHost : Host computer to query, omit for the local PC ' ' Usage: ' ~~~~~~ ' Call WMI_KillProcesse("explorer.exe") ' Call WMI_KillProcesse("excel.exe") ' Call WMI_KillProcesse("calculator.exe") ' ' Revision History: ' Rev Date(yyyy-mm-dd) Description ' ************************************************************************************** ' 1 2015-05-28 Initial Release ' 2 2020-08-21 Added Proc Header ' Code updated ' Updated Error Handler ' Made it Option Explicit compliant '--------------------------------------------------------------------------------------- Public Function WMI_KillProcesse(sProcessName As String, Optional sHost As String = ".") As Boolean On Error GoTo Error_Handler Dim oWMI As Object 'WMI object to query about the PC's OS Dim sWMIQuery As String 'WMI Query Dim oCols As Object Dim oCol As Object Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2") sWMIQuery = "SELECT Name FROM Win32_Process" Set oCols = oWMI.ExecQuery(sWMIQuery) For Each oCol In oCols If LCase(sProcessName) = LCase(oCol.Name) Then oCol.Terminate ' Kill this instances of the process End If Next oCol WMI_KillProcesse = True Error_Handler_Exit: On Error Resume Next Set oCol = Nothing Set oCols = Nothing Set oWMI = Nothing Exit Function Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: WMI_KillProcesse" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function جعفر Magnify.mdb

ضع هذا .... Me.Text0 = "" me.Text0.SetFocus

مساهمة من العبد لله لإثراء الموضوع تم الاستغناء عن جدول قيم الحروف والزر في النموذج وتم استعمال دالة بسيطة Public Function CharVal(SearchStr) As Long Dim i As Long, myval As Long If Not IsNull(SearchStr) Then Dim d As Object: Set d = CreateObject("Scripting.Dictionary"): d.Add "أ", 1: d.Add "ب", 2: d.Add "ج", 3: d.Add "د", 4: d.Add "ه", 5: d.Add "و", 6: d.Add "ز", 7: d.Add "ح", 8: d.Add "ط", 9: d.Add "ي", 10: d.Add "ك", 20: d.Add "ل", 30: d.Add "م", 40: d.Add "ن", 50: d.Add "س", 60: d.Add "ع", 70: d.Add "ف", 80: d.Add "ص", 90: d.Add "ق", 100: d.Add "ر", 200: d.Add "ش", 300: d.Add "ت", 400: d.Add "ث", 500: d.Add "خ", 600: d.Add "ذ", 700: d.Add "ض", 800: d.Add "ظ", 900: d.Add "غ", 1000: d.Add "ا", 1: d.Add "إ", 1: d.Add "آ", 1: d.Add "ء", 1: d.Add "ى", 10: d.Add "ئ", 10: d.Add "ؤ", 6: d.Add "ة", 5: d.Add " ", 0 For i = 1 To Len(SearchStr) myval = myval + d(Mid(SearchStr, i, 1)) Next i End If CharVal = myval End Function يتم استدعاؤها بعد تحديث مربع النص Private Sub text1_AfterUpdate() Me.text3.Value = CharVal(Me.text1.Value) End Sub تحياتي للجميع mas_charval.mdb

نيابة عن احبتي اقول بلسانهم كلنا ابوخليل .. واللي اخذ قلبك يتهنا به

تفضل اخي الكريم Private Sub Form_Current() On Error GoTo Err: If IsNull(Me.Text79) Then DoCmd.CancelEvent Else X1 = NoSpace(Me.Text79) ' Debug.Print X1 Me.[1].Value = Mid(X1, 1, 1) Me.[2].Value = Mid(X1, 2, 1) Me.[3].Value = Mid(X1, 3, 1) Me.[4].Value = Mid(X1, 4, 1) Me.[5].Value = Mid(X1, 5, 1) Me.[6].Value = Mid(X1, 6, 1) Me.[7].Value = Mid(X1, 7, 1) Me.[8].Value = Mid(X1, 8, 1) Me.[9].Value = Mid(X1, 9, 1) Me.[10].Value = Mid(X1, 10, 1) Me.[11].Value = Mid(X1, 11, 1) Me.[12].Value = Mid(X1, 12, 1) Me.[13].Value = Mid(X1, 13, 1) Me.[14].Value = Mid(X1, 14, 1) Me.[15].Value = Mid(X1, 15, 1) Me.[16].Value = Mid(X1, 16, 1) Me.[17].Value = Mid(X1, 17, 1) Me.[18].Value = Mid(X1, 18, 1) Me.[19].Value = Mid(X1, 19, 1) Me.[20].Value = Mid(X1, 20, 1) Me.[21].Value = Mid(X1, 21, 1) Me.[22].Value = Mid(X1, 22, 1) Me.[23].Value = Mid(X1, 23, 1) Me.[24].Value = Mid(X1, 24, 1) Me.[25].Value = Mid(X1, 25, 1) Me.[26].Value = Mid(X1, 26, 1) Me.[27].Value = Mid(X1, 27, 1) Me.[28].Value = Mid(X1, 28, 1) Me.[29].Value = Mid(X1, 29, 1) Me.[30].Value = Mid(X1, 30, 1) End If Err: End Sub Private Sub Text79_Exit(Cancel As Integer) Call Form_Current End Sub حروف.rar تحياتي وهذه اضافة على ملف استاذنا @kanory kan_001238.rar تحياتي

تفضل هذا المثال List.mdb

العفو منك اخي عمر لكن يوجد خطا 😂 تفضل التعديل =IIf(IsNull([txtDateBack]) And [txtDateEnd]>Format(Now();"yyyy/mm/dd");"اجازة" ;IIf(IsNull([txtDateBack]) And [txtDateEnd]<=Format(Now();"yyyy/mm/dd");"غياب" ;IIf(Not IsNull([txtDateBack]);"يعمل";"-"))) Project2.zip

تمام حجرب و اعلم حضرتك بالنتيجة شكرا جزيلا

إذا كنت تقصد الذي بين for و next فهو نفس السطر في الكود المختص الذي فيه n بين 6 و 116

مرة أخرى يجب تسمية العناصر بنفس ترنيب الشيت عنصر العمود f يكون اسمه txt6 عنصر العمود g يكون اسمه txt7 عنصر العمود h يكون اسمه txt8 وهكذا الى نهاية الخلايا التي تتم ترحيلها

يمكنك دمج المعادلتين معا ضع هذه المعادلة في الخلية H3 =IF(COUNTIF($A$3:$A3,$A3)>1,"",IFERROR(MODE(IF($A$3:$A$900=$A3,$F$3:$F$900)),INT(HARMEAN(IF($A$3:$A$900=$A3,$F$3:$F$900))))) مع الضغط على ctrl+shift+enter بالتوفيق

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

وهل يمكن استخدام دالة mode or harmean بشروط او بشرط في حالة البيانا ت الغير مرتبة او الغير مفهرسة

السلام عليكم استاذ @أ / محمد صالح بارك الله فيك وجعلها في ميزان حسناتك

لا هي تمام ناقص بس ازاي اضيف النصوص تلقائي مع معادله بتاعت حضرتك

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

هل تقصد بهذا الشكل List.mdb

بعتذر جدا على التاخر في الرد على حضرتك استاذي الفاضل وبشكرك جدا جدا على اهتمام حضرتك وانا كنت حاولت اعمل المعادله بطريقه تانيه لو ممكن حضرتك تشوفه كدا تمام ولا ايه لان عندي مشكله واحده لسه وهي ان لو الخانه فاضيه من غير تاريخ بتديني نتيجه غريبه شويه الملف في المرفقات بشكر حضرتك مره تانيه وبعتذر على التاخر في الرد UBIED.xlsx

لا نحب مثل هذه المواضيع مع شديد الاعتذار لاستاذي kanory

انت في منتدى كله خبراء وانا تلميذ لديهم انظر هل هذا جزء من اكوادك ..... Private Sub btnActivate_Click() Solved = CLng(Me.txtNum) If IsNumeric(Me.txtKey) = True Then If CLng(Nz(Me.txtKey, 0)) = 123456789 Then If Len(Me.txtCode) = 9 Then If Left(Me.txtCode, 1) = "i" Or Left(Me.txtCode, 1) = "c" Then If Right(Me.txtCode, 1) = "x" Or Right(Me.txtCode, 1) = "o" Then If IsNumeric(Mid(txtCode, 5, 1)) = True Then If IsNumeric(Mid(Me.txtCode, 3, 1)) = True Then If IsNumeric(Mid(Me.txtCode, 7, 1)) = True Then mNum = (Val(Mid(Me.txtCode, 3, 1)) + Val(Mid(txtCode, 5, 1)) + Val(Mid(Me.txtCode, 7, 1))) - 1 DLOldKey = Nz(DLookup("[OldKey]", "tblSetting"), 0) If Me.txtCode <> DLOldKey Then DoCmd.SetWarnings False DoCmd.RunSQL "Update tblSetting Set tblSetting.BaseDate=#" & Format(Date, "yyyy/mm/dd") & "#" DoCmd.RunSQL "Update tblSetting Set tblSetting.ActiveDate=#" & Format(DateAdd("m", mNum, Date), "yyyy/mm/dd") & "#" DoCmd.RunSQL "Update tblSetting Set tblSetting.OldKey='" & Me.txtCode & "'" DoCmd.SetWarnings True MB = MsgBox("Êã ÊÝÚíá ÇáäÙÇã ÈäÌÇÍ" & vbNewLine & "ÓÇÑí ÍÊì: " & DateAdd("m", mNum, Date), vbInformation, "Êã ÇáÊÝÚíá!") DoCmd.Close DoCmd.OpenForm "frmMainLogin" Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ãäÊåí ÇáÕáÇÍíÉ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If ElseIf Me.txtCode = "ÊÓÊ íÇ Úã" Then Me.txtCode = "" MB = MsgBox("Êã ÊÝÚíá ÇáäÙÇã ãÄÞÊÇ", vbInformation, "Êã ÇáÊÝÚíá!") DoCmd.Close DoCmd.OpenForm "frmMainLogin" Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtKey = "" MB = MsgBox("ãÝÊÇÍ ÇáÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtKey.SetFocus End If Else Me.txtKey = "" MB = MsgBox("ãÝÊÇÍ ÇáÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtKey.SetFocus End If End Sub

كل شيء ممكن لما نفكر فيه بطريقة سليمة جرب هذه المعادلة في الخلية B2 =MID(A2, 1,FIND(CHAR(10),A2)-1) والمعادلة التالية في الخلية C2 =MID(A2, FIND(CHAR(10),A2)+1, 10) بالتوفيق

من اعدادات الصفحة حدد الطابعة و بعد التحديد ستجد ان عرض الورقة اختلف و صار اصغر

استاذنا @الحلبيالمهم مشاركاتك القيمة التي ننتفع منها لكن لدي سؤال خارج الموضوع ... ماعلاقة (الحلبي ) بمصر ؟ احترامي الكبير لكل اوطاننا

أخي الفاضل في حدث عند فتح المصنف راجع هذا السطر Select Case MBSerialNumber وهو لاختبار حالات المتغير MBSerialNumber الذي تنتجه الدالة المعرفة MBSerialNumber الموجودة في الموديول المنفصل فإذا كانت MBSerialNumber مثل واحدة من strMB1, strMB2, strMB3 لا يفعل شيئا ويستمر في فتح المصنف وإذا كانت غير ذلك يغلق المصنف مع حفظ التغييرات بالتوفيق

لا أدري أين المشكلة عندك ولكن إذا كنت تريد تطبيق ذلك على ملف آخر بامتداد xlsb أولا تفتح شاشة الفيجوال بيسك داخل اكسل ثم تضيف موديول جديد وتلصق فيه الكود الذي يتحقق من رقم الماذربورد Function MBSerialNumber(Optional strComputer As String = ".") As String Dim v, vName, vUUID With GetObject("winmgmts:\\" & strComputer & "\root\cimv2") For Each v In .ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", , 48) vName = v.Name: vUUID = v.UUID Next v End With MBSerialNumber = vName & ", " & vUUID End Function ثم تضغط دبل كلك على thisworkbook وتلصق هذا الكود في حدث عند فتح الملف Private Sub Workbook_Open() Dim strMB1 As String, strMB2 As String, strMB3 As String 'Put Your MotherBoard Serial strMB1 = "HP ProDesk 490 G1 MT, FF004080-EE39-11E3-BFF8-A0D3C13F35B2" strMB2 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F" strMB3 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F" Select Case MBSerialNumber Case strMB1, strMB2, strMB3 Exit Sub Case Else MsgBox ("Data Security Failure. This Workbook Will Close") ActiveWorkbook.Close 1 End Select End Sub ثم تقوم بحفظ التغييرات وتغلق وتفتح الملف مرة أخرى بالتوفيق

بالاضافة الى ما تفضل به استاذنا الفاضل @د.كاف يار وله جزيل الشكر تفضل اخي الكريم جرب الكود التالي Dim strFolderPath As String Dim DB_Full_Name As String Dim DB_Name As String Dim Backup_Full_Name As String Dim Copy_File As Variant Dim DB_Directory As String strFolderPath = CurrentProject.Path & "\Backup\" ' التاكد من وجود مجلد Backup ' اذ لم يكن موجود يتم انشائه If Len(Dir(strFolderPath, vbDirectory)) = 0 Then MkDir strFolderPath End If ' تحديد قاعدة البيانات DB_Full_Name = CurrentProject.Path & "\" & CurrentProject.Name ' تحديد مسار قاعدة البيانات DB_Directory = CurrentProject.Path ' تحديد اسم قاعدة البيانات DB_Name = CurrentProject.Name ' تحديد مسار النسحة الاحتياطية Backup_Full_Name = strFolderPath & Left(DB_Name, Len(DB_Name) - 6) & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & ".accde" If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", vbQuestion + vbYesNo, "نسخة احتياطية") = vbYes Then Set Copy_File = CreateObject("Scripting.FileSystemObject") Copy_File.copyfile DB_Full_Name, Backup_Full_Name, True End If تحياتي

تفضل هذا الكود فقط انسخ و الصق في ازرار النسخة الاحتياطية On Error GoTo ErrH Dim fso As Object Dim fldrname As String Dim fldrpath As String Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\Backup" If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) DoCmd.RunSQL "CREATE TABLE Backup (Backup_NO INT , Backup_Name VARCHAR (50) , Backup_Path VARCHAR (100), Backup_Date Date);" End If Dim MyFile, DstFile, DataName As String Dim Syso As Object MyFile = CurrentProject.FullName DataName= "Backup-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ")" DstFile = CurrentProject.Path & "\Backup\" & DataName & ".accdb" DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Name DstFile As DstFile & ".ptc" DBEngine.CompactDatabase DstFile & ".ptc", DstFile Kill DstFile & ".ptc" Dim db As DAO.Database Dim MaxBackup_NO As Integer MaxBackup_NO = Nz(DMax("[Backup_NO]", "[Backup]"), 0) + 1 Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("Backup") With rs .AddNew ![Backup_NO] = MaxBackup_NO ![Backup_Name] = DataName ![Backup_Path] = DstFile ![Backup_Date] = Now() .Update End With rs.Close Set rs = Nothing MsgBox "تم انشاء قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تاكيد" Exit Sub ErrH: Select Case Err.Number End Select

اختصارت جميع الاوامر فى الورد نقل عن الدكتور سعود عقيل رمضان كريم 2021 ملخص اختصارات وورد.DOC

الكود عندي شغال تمام على الكشوفات النهائية ولا توجد مشكلة عكس الترتيب . فقط عندك في الملف نطاق الطباعة حتى N52 نتائج الطلاب نصفي١.xlsb

إليكم أيها الزملاء برنامج كنترول Control2021pro لكنترول هذا العام البرنامج للمرحلتين الابتدائية و الاعدادية: البرنامج سهل وبسيط ويشمل على : للترمين- لكشوف للنتيجة بعد انهاء الرصد للترمين - شهادات للترمين - كشوف الجان بالاضافة إلى سرعة عالية جدا فى اداء العمليات الحسابية والمعالجات المختلفة و يمكن التحكم فى كل وظائف البرنامج بواسطة لوحة التحكم ارجو منكم تجربته وأنتظر تعليقاتكم ... تـــم رفع أخر تعديلات للبرنامج هنا 161502775899311.rar

السلام عليكم بعد اذن الاخوة الاعزاء انظر للملفين المرفقين اتمنى ان يكون المطلوب تحياتي استيراد.rar استيراد وحذف وتصدير اكسيل.rar

بسم الله الرحمن الرحيم أعزائي أعضاء ومشرفي منتدى أوفيسنا بدأت تعلم البرمجة من هنا ثم انتقلت بين لغات البرمجة وتعمقت في php ولكن أريد عمل برنامج بالأكسس فواجهتني مشكلة وهي: أريد وضع نتيجة استعلام في متغيرات وخاصة في حالة تكون النتيجة أكثر من سجل والسجل أكثر من حقل وهذه في لغة بي اتش بي في منتهى السهولة بدالة تسمى mysql_fetch_array وتقوم هذه الدالة بوضع متغيرات بعدد الصفوف والأعمدة في نتيجة الاستعلام بحيث إذا أردت استعمال الداتا الموجودة في الصف الأول والعمود الأول يكون هذا في متغير وإذا أردت استعمال الداتا الموجودة في الصف الثاني ومثلا العمود الثالث يكون ذلك في متغير آخر فكيف يمكن تنفيذ ذلك في الأكسس؟؟ تحياتي للجميع وكل عام أنتم بخير بمناسبة الشهر المبارك

سلمت أناملك الابداع تجلى في : الضبط والاتقان بأقل عدد من الاسطر

أخي الكريم الكود وظيفته هي قراءة دقة الشاشة لدى المستخدم ومقارنتها بأفضل دقة وهي المحددة منك في استدعاء الدالة resizefrom Me, 1024, 768 ثم إذا كانت غير المحددة منك يتم تغيير حجم النموذج وكل عناصره بما يتناسب مع دقة الشاشة الموجودة بجهاز المستخدم سواء بتكبير حجم النموذج إذا كانت دقته أعلى من المحددة في الكود أو بتصغيره إذا كانت دقة أصغر من المحددة في الكود أما بالنسبة للمسافات بين العناصر فهي أيضا تمت مراعاتها حيث يتم تحديد موضوع العنصر في النموذج بناء على دقة الشاشة ...... ويبدأ الكود ب wrate = DisplaySize(0) / bestw hrate = DisplaySize(1) / besth ويعني معدل العرض يساوي ناتج قمة عرض شاشة المستخدم على أفضل عرض (المحدد في استدعاء الدالة) وكذلك معدل الارتفاع ثم frm.InsideWidth = frm.InsideWidth * wrate frm.InsideHeight = frm.InsideHeight * hrate وتعني تغيير عرض النموذج إلى عرض النموذج الأصلي مضروباً في معدل العرض (المحسوب سابقاً) وكذلك تغيير ارتفاع النموذج ثم Dim fc As Control For Each fc In frm.Controls fc.Top = fc.Top * hrate fc.Left = fc.Left * wrate fc.Width = fc.Width * wrate fc.Height = fc.Height * hrate Next وتعني أنه يتم تغيير موضع كل عنصر تحكم في النموذج إلى موضعه الجديد الناتج عن ضرب مكانه الأصلي في معدل العرض أو الارتفاع وتم تغيير ما يلي مكانه بالنسبة لأعلى النموذج ومكانه بالنسبة ليسار النموذج وعرضه وارتفاع هذا هو شرح الدالة وكيفية عملها ........ ولكن ما معنى نموذج يملأ الشاشة؟؟

أخي الكريم إذا استعملت البحث في أوفيسنا ستجد روائع في هذا المجال هذا الرابط واحد منها http://www.officena....showtopic=31297 وأنا بطبعي أحب الاختصار فقمت بعمل كود مختصر يقوم بنفس الغرض إن شاء الله فقط ضع في موديول الكود التالي Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long Function resizefrom(frm As Form, bestw As Integer, besth As Integer) On Error Resume Next wrate = DisplaySize(0) / bestw hrate = DisplaySize(1) / besth frm.InsideWidth = frm.InsideWidth * wrate frm.InsideHeight = frm.InsideHeight * hrate Dim fc As Control For Each fc In frm.Controls fc.Top = fc.Top * hrate fc.Left = fc.Left * wrate fc.Width = fc.Width * wrate fc.Height = fc.Height * hrate fc.FontSize = fc.FontSize * wrate Next End Function وفي حدث عن تحميل النموذج قم باستدعاء الدالة كالتالي resizefrom Me, 800, 600 حيث 800 في 600 هي دقة الشاشة المناسبة لعرض النموذج بدون تحجيم (يمكنك كتابة دقة الشاشة الحالية التي تصمم فيها البرنامج) وإذا تغيرت عن هذا يتغير حجم النموذج سواء بالتكبير أو بالتصغير جرب وأخبرني بالنتيجة

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

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

أحببت ففقط أن أضيف معلومة بسيطة وهي لوكتبت DoCmd.OutputTo ac-, name مع استبدال (-) بالنوع سواء الجدول table أو الاستعلام query أو التقرير report أو حتى النموذج form واستبدال name باسم الملف سواء كان جدول أو تقرير أو غيره بهذين المتغيرين فقط سيتم فتح معالج التصدير وتختار منه الكثير من الامتدادت أكثر مما ترغب والكثير من الخيارات المتقدمة

مرفق مثال بسيط يكون فيه التعديل والإضافة ممنوعين إلا بعد الضغط على زر السماع بالإضافة والتعديل ويكون ذلك بجعل جصائص النموذج السماح بالتحرير _____ لا السماح بلإضافة _____ لا ثم نضيف هذا الكود عند النقر على الزر Me.AllowEdits = True Me.AllowAdditions = True أرجو أن يكون هذا المطلوب db1.rar

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته أواصل معكم سلسلة ما خف وزنه وغلا وأقدم لكم اليوم برنامج مصمم بالأكسس من تصميمي للاستماع للقرآن الكريم بصوت أكثر من ستين قارئ مع قراءة السورة مع القارئ من خلال الفلاش الموجود أسفل البرنامج فقط حدد القارئ ثم حدد السورة ثم حدد السورة في الفلاش واستمع واقرأ القرآن واحصل على الكثير من الثواب ويمكنك تحميل السورة للعلم كل الملفات بصيغة mp3 حجم الملف 95 كب هذه صورة البرنامج http://www6.0zz0.com/2008/01/05/15/47435727.gif ومن هنا يكون التحميل لا ينقصني سوى دعاؤكم وردودكم إن أردتم ذلك أخوكم محمد الصالح

وهذه إضافة أخرى زر للتحميل بصيغة mp3 وآخر للتحميل بصيغة rm من هنا

وإليكم النسخة الثانية وبها تعديل بسيط وهو التصغير إلى جوار الساعة الملف بالمرفقات quran2.rar

جمييييييييييييل جدا ويمكنك الاستفادة من ذلك إن شاء الله http://www.4shared.com/file/32109478/b82dbeb9/mnztrl.html

بشكر حضرتك جدا لتعبك معايا بس انا كنت محتاج انه يكتب لو خانه ال B فيها تاريخ يكنب كلمه "تمام ومده الاستلام( ويطرح ال Bمن ال A ) لو ال B فاضيه يكتب لم يتم الاستلام وتم التسليم من( ويطرح تاريخ اليوم من الخانه A) او خانه ال A وال B فاضيه ما يكتبش حاجه بشكرك جدا جدا