علي المصري

السلام عليكم ورحمة الله وبركاته في الصورة تظهر الحرف F قبله الرقم 3 واذا كتب الرقم 2 سوف تظهر مكان ال F رمز E+ اريد عمل تنسيق شرطي لهذا الصف بحيث يكون الخلفية حمراء في حالة ال F مع تلوية القيمة صفر باللون الاحمر حتى لا يظهر ام اذا كانت الخلية بها الرمز +E فاريدها بلون اخر ويتم تلوين الصفر في هذه الحالة بنفس اللون الذي تم تخصيصة في حالة الرمز +E حاولت كثيرا بالمعادلات لكنها لم تضبط معي ارجو افادتي في اسرع وقت اذا سمحت ظروفكم واوقاتكم مع الشكر الجزيل

شكرا جزيلا استاذنا الكبير بارك الله فيك

جزاك الله خيرا

up

شكرا جزيلا ولكن نريد حل فاصل

up up

وعليكم السلام ورحمة الله وبركاته جزاك الله خيرا

السلام عليكم ورحمة الله وبركاته لدي قاعدة بيانات تعمل جيدا على النواتين 32bit and 64bit ولكن عند تحويلها إلى ACCDE لا تعمل على نظام 32bit ولا ادري لماذا هل من حل؟

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

لدي مجموعة من الاعداد وليكن 6 أعداد كالتالي 41, 25 , 45 , 74 , 15 , 70 مرتبة في ستة اعمدة هل فيه امكانية نحصل على مجموع اكبر عددين Book1.rar

السلام عليكم ورحمة الله وبركاته الكود التالي يعمل جيد مع 32بت ولا يعمل مع ال 64بت يرحى التعديل مع الشكر Private Sub zer1_Click() On Error GoTo ErrHandler ' Dim Filename As Variant Dim SourceFile, DestinationFile Dim picturepaht picturepaht = GetOpenFile_CLT("", "ÇÎÊÑ ÕæÑÉ :") With picturepaht If picturepaht <> "" Then Me.imgLogo.Picture = picturepaht logo = picturepaht Else MsgBox "No image selected." End If End With SourceFile = logo DestinationFile = CurrentProject.Path & "\" & "shar" & ".jpg" FileCopy SourceFile, DestinationFile MsgBox "Êã ÊÛííÑ ÇáÔÚÇÑ" ErrHandler: If Err.Number = 94 Then imgLogo.Picture = CurrentProject.Path & "\" & "shar" & ".jpg" MsgBox " áã íÊã ÊÛííÑ ÇáÔÚÇÑ" End If End Sub GetOpenFile_CLT("", "اختر صورة") MsgBox "لم يتم تغيير الشعار" Option Compare Database Private Type CLTAPI_OPENFILE strFilter As String intFilterIndex As Long strInitialDir As String strInitialFile As String strDialogTitle As String strDefaultExtension As String lngFlags As Long strFullPathReturned As String strFileNameReturned As String intFileOffset As Integer intFileExtension As Integer End Type Const ALLFILES = "All Files" Private Type CLTAPI_WINOPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustrFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustrData As Long lpfnHook As Long lpTemplateName As String End Type Const OFN_ALLOWMULTISELECT = &H200 Const OFN_CREATEPROMPT = &H2000 Const OFN_EXPLORER = &H80000 Const OFN_FILEMUSTEXIST = &H1000 Const OFN_HIDEREADONLY = &H4 Const OFN_NOCHANGEDIR = &H8 Const OFN_NODEREFERENCELINKS = &H100000 Const OFN_NONETWORKBUTTON = &H20000 Const OFN_NOREADONLYRETURN = &H8000 Const OFN_NOVALIDATE = &H100 Const OFN_OVERWRITEPROMPT = &H2 Const OFN_PATHMUSTEXIST = &H800 Const OFN_READONLY = &H1 Const OFN_SHOWHELP = &H10 #If Win64 = 1 And VBA7 = 1 Then Declare PtrSafe Function CLTAPI_GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _ (pOpenfilename As CLTAPI_WINOPENFILENAME) _ As LongPtr Declare PtrSafe Function CLTAPI_GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _ (pOpenfilename As CLTAPI_WINOPENFILENAME) _ As LongPtr Declare PtrSafe Sub CLTAPI_ChooseColor Lib "msaccess.exe" Alias "#53" _ (ByVal hWnd As Long, rgb As Long) #Else Declare Function CLTAPI_GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _ (pOpenfilename As CLTAPI_WINOPENFILENAME) _ As Boolean Declare Function CLTAPI_GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _ (pOpenfilename As CLTAPI_WINOPENFILENAME) _ As Boolean Declare Sub CLTAPI_ChooseColor Lib "msaccess.exe" Alias "#53" _ (ByVal hWnd As Long, rgb As Long) #End If Function GetOpenFile_CLT(strInitialDir As String, strTitle As String) As String Dim fOK As Boolean Dim typWinOpen As CLTAPI_WINOPENFILENAME Dim typOpenFile As CLTAPI_OPENFILE Dim strFilter As String On Error GoTo PROC_ERR strFilter = CreateFilterString_CLT("JPEG (*.JPG)" & Chr$(0) & "*.JPG" & Chr$(0) & "Gif (*.GIF)" & Chr$(0) & "*.GIF" & Chr$(0)) If strInitialDir <> "" Then typOpenFile.strInitialDir = strInitialDir Else typOpenFile.strInitialDir = CurDir() End If If strTitle <> "" Then typOpenFile.strDialogTitle = strTitle End If typOpenFile.strFilter = strFilter typOpenFile.lngFlags = OFN_HIDEREADONLY Or OFN_SHOWHELP ConvertCLT2Win typOpenFile, typWinOpen fOK = CLTAPI_GetOpenFileName(typWinOpen) ConvertWin2CLT typWinOpen, typOpenFile GetOpenFile_CLT = typOpenFile.strFullPathReturned PROC_EXIT: Exit Function PROC_ERR: GetOpenFile_CLT = "" Resume PROC_EXIT End Function Sub ConvertCLT2Win(CLT_Struct As CLTAPI_OPENFILE, Win_Struct As CLTAPI_WINOPENFILENAME) Dim strFile As String * 512 On Error GoTo PROC_ERR Win_Struct.hwndOwner = Application.hWndAccessApp Win_Struct.hInstance = 0 If CLT_Struct.strFilter = "" Then Win_Struct.lpstrFilter = ALLFILES & Chr$(0) & "*.*" & Chr$(0) Else Win_Struct.lpstrFilter = CLT_Struct.strFilter End If Win_Struct.nFilterIndex = CLT_Struct.intFilterIndex Win_Struct.lpstrFile = String(512, 0) Win_Struct.nMaxFile = 511 Win_Struct.lpstrFileTitle = String$(512, 0) Win_Struct.nMaxFileTitle = 511 Win_Struct.lpstrTitle = CLT_Struct.strDialogTitle Win_Struct.lpstrInitialDir = CLT_Struct.strInitialDir Win_Struct.lpstrDefExt = CLT_Struct.strDefaultExtension Win_Struct.Flags = CLT_Struct.lngFlags Win_Struct.lStructSize = Len(Win_Struct) PROC_EXIT: Exit Sub PROC_ERR: Resume PROC_EXIT End Sub Sub ConvertWin2CLT(Win_Struct As CLTAPI_WINOPENFILENAME, CLT_Struct As CLTAPI_OPENFILE) ' On Error GoTo PROC_ERR CLT_Struct.strFullPathReturned = left(Win_Struct.lpstrFile, InStr(Win_Struct.lpstrFile, vbNullChar) - 1) CLT_Struct.strFileNameReturned = RemoveNulls_CLT(Win_Struct.lpstrFileTitle) CLT_Struct.intFileOffset = Win_Struct.nFileOffset CLT_Struct.intFileExtension = Win_Struct.nFileExtension PROC_EXIT: Exit Sub PROC_ERR: Resume PROC_EXIT End Sub Function CreateFilterString_CLT(ParamArray varFilt() As Variant) As String Dim strFilter As String Dim intCounter As Integer Dim intParamCount As Integer On Error GoTo PROC_ERR intParamCount = UBound(varFilt) If (intParamCount <> -1) Then For intCounter = 0 To intParamCount strFilter = strFilter & varFilt(intCounter) & Chr$(0) Next If (intParamCount Mod 2) = 0 Then strFilter = strFilter & "*.*" & Chr$(0) End If End If CreateFilterString_CLT = strFilter PROC_EXIT: Exit Function PROC_ERR: CreateFilterString_CLT = "" Resume PROC_EXIT End Function Function RemoveNulls_CLT(strIn As String) As String Dim intChr As Integer intChr = InStr(strIn, Chr$(0)) If intChr > 0 Then RemoveNulls_CLT = left$(strIn, intChr - 1) Else RemoveNulls_CLT = strIn End If End Function

وجدت هذا الكود لكن لا يعمل مع الخاصية can grew = yes يعتمد على ارتفاع نربع النص او التسمية بمعنى ان اذا تم عمل ارتفاع مربع النص على ان يظهر فيه سطرين سوف يكون المحاذاة على هذا الحد حتى اذا كانت الخاصية can grew = yes Option Explicit '' Copyright Lebans Holdings 1999 Ltd. '' www.lebans.com '' Please note this method will always be off '' by one pixel due to rounding. '' Vertical Justification is performed in the same manner '' as Excel. We are trying to center the Top of a capital '' character and the bottom(baseline) of the capital character. '' If you look in the Reports section on my web site you will '' find code that uses the ascending and descending char values '' to calculate a more accurate vertical justification. Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) ' You have to call the function every time ' during the Report's Detail Format event. VerticalAlignCenter Me.MyNotes VerticalAlignCenter Me.id VerticalAlignCenter Me.MyName1 VerticalAlignCenter Me.MyName2 VerticalAlignCenter Me.MyName3 VerticalAlignCenter Me.MyName4 End Sub Public Sub VerticalAlignCenter(ByRef ctl As Control) '(ctl As Control) 'access 32bit On Error GoTo ErrorCode Dim MinimumMargin As Integer Dim BorderWidth As Integer Dim TwipsPerPoint TwipsPerPoint = 20 If Not ((TypeOf ctl Is TextBox) Or (TypeOf ctl Is Label)) Then Exit Sub 'Figure out how many lines it is Dim LenOfText, WidOfBox, NumberOfLines, HtOfText If TypeOf ctl Is TextBox Then LenOfText = ctl.Text Else: LenOfText = ctl.Caption End If 'how wide is this puppy? WidOfBox = ctl.Width LenOfText = (Len(LenOfText) * TwipsPerPoint * ctl.FontSize) / 2 NumberOfLines = Int(LenOfText / WidOfBox) + 1 HtOfText = NumberOfLines * TwipsPerPoint * ctl.FontSize MinimumMargin = 1 * TwipsPerPoint BorderWidth = (ctl.BorderWidth * TwipsPerPoint) / 2 ctl.TopMargin = ((ctl.Height - HtOfText) / 2) - MinimumMargin - BorderWidth ErrorCode: Exit Sub End Sub نرجو تعديل الكود لكي يعمل بشكل صحيح مع كل الحالات VerticalJustify2.rar

انا استخدمت التالي Me.MyDay = WeekdayName(Weekday(Me.MyDate))

شكرا جزيلا استاذنا الفاضل جزاك الله خيرا

السلام عليكم ورحمة الله وبركاته في المرفق يوجد Form 1 عند اختيار اسم الفريق ثم احتيار رقم السؤال يبدا التايمر العد التنازلي من 60 عند اختيار الإجابة تظهر رسالة تأكيد عملية الاختيار اريد عند اختيار yes في هذا الرسالة يتم عمل توقف أو إلغاء للتايمر وعند اختيار No يظل التايمر شغال مع الشكر الجزيل للجميع AA.rar

شكرا جزيلا جربت الكود الخاص بالأستاذ رمهان أيضا وأدي الوظيفة المطلوبة وجربته بالشكل التالي أيضا DoCmd.GoToRecord , "", acNewRec شكرا مرة اخرى ماذا عن تشغيل ملف ام بي 3 من خلال زر وإيقاف التشغيل عن طريق زر آخر

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

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

السلام عليكم ورحمة الله وبركاته انا في صدد عمل برنامج لمسابقة في المدرسة الملف المرفق به فورم رقم 1 بها ازرار كل زر لإظهار سؤال ( ممكن يكون السؤال في فورم في قاعدة البيانات او ملف فلاش أو صورة ) المفروض ان عند الضغط على سؤال يصبح الزر غير فعال وقبل الضغط على زر السؤال لابد من اختيار اسم الفريق وبعد الانتهاء من الإجابة تحدد الإجابة هل هي صواب ام خطأ المشكلة هي التالي: عند انتهاء الفريق الأول من الإجابة وتحديد الإجابة هل هي صواب ام خطأ المفروض اني اختار اسم الفريق الثاني لكي يبدأ في اختيار سؤال والاجابة عليه ولكن البرنامج الذي وصلت اليه حتى الآن لا يسجل كل فريق ولكن يسجل اخر شيء قبل غلق الفورم اريد عند اختيار اسم الفريق او الضغط على زر الحفظ يتم تسجيل نتيجة هذا الفريق ويبدأ من جديد يستقبل بيانات الفريق الجديد وهكذا ما الخطأ عندي المسابقة.rar

السلام عليكم ورحمة الله وبركاته شكرا على الاهتمام وجزاك الله خيرا

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

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

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

up

تفضل احد الحلول crossed.rar