Shivan Rekany

الیک ھذا Database13.rar

اتفضل اخي احذف كل الاكواد السابقة واليك هذه الاواد اللازمة للنموذج Option Compare Database Dim Sec As Integer Private Sub AddPictures_Click() On Error Resume Next Dim x As FileDialog Dim MyNam As String Dim Mesar As String Set x = Application.FileDialog(msoFileDialogFilePicker) x.AllowMultiSelect = True If x.Show = -1 Then For i = 1 To x.SelectedItems.Count MyNam = Mid$(Trim(x.SelectedItems(i)), InStrRev(Trim(x.SelectedItems(i)), "\") + 1) FileCopy Trim(x.SelectedItems(i)), CurrentProject.Path + "\fileStores\" & ("" & MyNam & "") Mesar = CurrentProject.Path + "\fileStores\" & ("" & MyNam & "") Me.PicFile = CurrentProject.Path + "\fileStores\" & ("" & MyNam & "") Me.imgPicture.Picture = CurrentProject.Path + "\fileStores\" & ("" & MyNam & "") DoCmd.GoToRecord , , acNext Next i Me.imgPicture.Requery End If Set x = Nothing End Sub Private Sub AutoChange_Click() Me.StopAndResume.Visible = True Me.StopAndResume.Caption = "Stop" Me.TimerInterval = 1000 DoCmd.GoToRecord , , acFirst End Sub Private Sub Form_Timer() Sec = Sec + 1 If Sec >= 3 And Me.CurrentRecord <> Me.RecordsetClone.RecordCount Then DoCmd.GoToRecord , , acNext Sec = 0 ElseIf Sec >= 3 And Me.CurrentRecord = Me.RecordsetClone.RecordCount Then MsgBox "æÕáäÇ Çáì ÇÎÑ ÕæÑÉ .. ÓíÊã ÇÛáÇÞ ÇáäãæÐÌ" DoCmd.Close acForm, Me.Name End If End Sub Private Sub StopAndResume_Click() If Me.StopAndResume.Caption = "Stop" Then Me.TimerInterval = 0 Me.StopAndResume.Caption = "Resume" Exit Sub ElseIf Me.StopAndResume.Caption = "Resume" Then Me.TimerInterval = 1000 Me.StopAndResume.Caption = "Stop" Exit Sub End If End Sub واليك ملفك بعد تعديل pic.rar

فقط عليك ان تحذف هذه من الكود 'If Not IsNull(PicFile) = True Then '.InitialFileName = PicFile 'Else '.InitialFileName = "" 'End If ولهذا اضفت هذه اسطر للكود Dim newa As String newa = Mid$(Trim(.SelectedItems(1)), InStrRev(Trim(.SelectedItems(1)), ".") + 1) If newa = "jpg" Or newa = "png" Or newa = "ico" Or newa = "bmp" Or newa = "gif" Or newa = "tif" Or newa = "tga" Then FileCopy Trim(.SelectedItems(1)), CurrentProject.Path + "\fileStores\" & PicName("" & xPic & "") ElseIf newa = "mp3" Or newa = "wma" Or newa = "ape" Or newa = "amr" Or newa = "wav" Or newa = "mp4" Or newa = "avi" Then FileCopy Trim(.SelectedItems(1)), CurrentProject.Path + "\fileStores\watch\" & PicName("" & xPic & "") ElseIf newa = "txt" Or newa = "docx" Or newa = "doc" Or newa = "exlx" Then FileCopy Trim(.SelectedItems(1)), CurrentProject.Path + "\fileStores\doc\" & PicName("" & xPic & "") End If وتقدر ان تضيف انواع اخرى من نوع القراءة مثلا بي دي اف و الخ الى الكود تيكست اي الى جملة الشرطية و ايضا لنوع الفيديو اليك المرفق بعد تعديل test_move.rar

لان يتغير الطلبيات من عنوان الموضوع لذلك لا تجد من يرد عليك اليك هذا الرابط وهذا ايضا

اخی العزیز نزلت المرفق لکن بیفتح عندی بشکل عادی وما یتأخر عند الفتح احتمال السبب ان یکون ھناک اشیاء اخرى ما ارفقت مع القاعدة ... يعني عندي مافيه مشكلة .. انت ايضا نزل المرفق وفتحه هل سيكون بطيئة ام لا تحياتي

نعم

انا حملت من جديد وما فيه مشكلة يللا الي من جديد login.rar

اتفضل القي نظرتا الى استعلام كيو2017 فقط علي ان تفتح استعلام كيو2017 مرة واحدة بواسطة زر او بدون زر Database1 (1).rar

اتفضل القي نظرتا الى استعلام لو اين و لوك اوت login.rar

السلام عليكم ورحمة الله وبركاته اولا : اسم موضوعك مخالف للقوانين المنتدى ثانيا : ارفع نسخة مصغرة من قاعدة بياناتك لعمل عليه

اتفضل هذه هو الاكواد المطلوبة للنقطة الاولى والثالثة Option Compare Database Option Explicit Public Sub Foo_Bar() Dim db As DAO.Database Dim prp As DAO.Property Dim fld Set db = CurrentDb With db.TableDefs("ج_الملاك").Fields("رقم88اخر") Set prp = .CreateProperty("InputMask", dbText, "0000000000", False) 'dbText = 10 .Properties.Append prp End With Set fld = db.TableDefs("ج_الملاك").Fields("رقم88اخر") fld.Name = "رقم_اخر" End Sub Private Sub COMMAND12_Click() On Error Resume Next Dim SqlUpdate As String Dim DELF As String Dim ADDF As String DoCmd.SetWarnings False SqlUpdate = "UPDATE ج_الملاك SET [رقم88اخر] = 0 & [ج_الملاك]![رقم_اخر] WHERE (((Len([رقم_اخر]))<10));" ADDF = "ALTER TABLE ج_الملاك ADD COLUMN رقم88اخر TEXT(10)" DELF = "ALTER TABLE ج_الملاك DROP COLUMN رقم_اخر" Me.ج_الملاك.SourceObject = "" DoCmd.RunSQL (ADDF) DoCmd.RunSQL (SqlUpdate) DoCmd.RunSQL (DELF) Call Foo_Bar Me.ج_الملاك.SourceObject = "ج_الملاك" DoCmd.SetWarnings False End Sub واليك المرفق مثال 1.rar

لا بل تقدر جلب مجموعە قیم من استعلام الى استعلام اخر لكن نحن نحتاج لقاعدة مصغرة بها استعلام الاساسي وايضا نحتاج نعرف ما تريد ان نخرج منه الى استعلام اخر .. اي وضح لنا ماتريد مع تقدير

pic.rar

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

اتفضل اخي هذه وحدة نمطية و اكواد لاحتياج طلبك Option Compare Database 'This code was originally written by Terry Kreft. 'It is not to be altered or distributed, 'except as part of an application. 'You are free to use it in any application, 'provided the copyright notice is left unchanged. ' 'Code courtesy of 'Terry Kreft Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _ "SHGetPathFromIDListA" (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _ "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _ As Long Private Const BIF_RETURNONLYFSDIRS = &H1 Public Function BrowseFolder(szDialogTitle As String) As String Dim x As Long, bi As BROWSEINFO, dwIList As Long Dim szPath As String, wPos As Integer With bi .hOwner = hWndAccessApp .lpszTitle = szDialogTitle .ulFlags = BIF_RETURNONLYFSDIRS .ulFlags = .ulFlags Or &H40 End With dwIList = SHBrowseForFolder(bi) szPath = Space$(512) x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath) If x Then wPos = InStr(szPath, Chr(0)) BrowseFolder = Left$(szPath, wPos - 1) Else BrowseFolder = vbNullString End If End Function اكواد في نموذج Option Compare Database Dim Sec As Integer Private Sub AddPictures_Click() On Error Resume Next Dim x As FileDialog Set x = Application.FileDialog(msoFileDialogFilePicker) x.AllowMultiSelect = True If x.Show = -1 Then For i = 1 To x.SelectedItems.Count Me.PicFile = x.SelectedItems(i) DoCmd.GoToRecord , , acNext Next i Me.imgPicture.Requery End If End Sub Private Sub AutoChange_Click() Me.StopAndResume.Visible = True Me.StopAndResume.Caption = "Stop" Me.TimerInterval = 1000 DoCmd.GoToRecord , , acFirst End Sub Private Sub Form_Timer() Sec = Sec + 1 If Sec >= 3 And Me.CurrentRecord <> Me.RecordsetClone.RecordCount Then DoCmd.GoToRecord , , acNext Sec = 0 ElseIf Sec >= 3 And Me.CurrentRecord = Me.RecordsetClone.RecordCount Then MsgBox "æÕáäÇ Çáì ÇÎÑ ÕæÑÉ .. ÓíÊã ÇÛáÇÞ ÇáäãæÐÌ" DoCmd.Close acForm, Me.Name End If End Sub Private Sub StopAndResume_Click() If Me.StopAndResume.Caption = "Stop" Then Me.TimerInterval = 0 Me.StopAndResume.Caption = "Resume" Exit Sub ElseIf Me.StopAndResume.Caption = "Resume" Then Me.TimerInterval = 1000 Me.StopAndResume.Caption = "Stop" Exit Sub End If End Sub وهذه ملفك بعد تعديل اختیار اکثر من صورة و تشغيل تلقائي.rar

استغر الله نحن في خدمتك

الفرق بينهما هو طريقتي بيعطيك ارقام سالب ايضا مثلا عندك سجل وقت دخول هو 11:44 ووقت الخروج هو 10:40 لذلك يعطيك سالب وعند سجل وقت الدخول 03:35 ووقت الخروج هو 05:40 لذلك يعطيك موجب اي طريقتي بيعطيك اللي رقمه الموجب فقط وتقدر ان تعمل لكي يعدد كل سجلات اي تحويل ارقام سالب الى الموجب وتعدده لكن الطريقة استاذنا @محمدنجار بيعطيك فقط ارقام موجب لذلك بيعدد كل سجلات

نعم استاذنا @محمدنجار انا معك انت عطيته كود مناسب لكن هو استخدمت مع كودك كلمة ( and ) بدل کلمة ( or ) ھناک کان قصدی باستاذ @اسلام سيد وليس ب حضرتك تقبل تحياتي

اتفضل انا عملت لك مشاهدة تلقائي خلال 3 ثواني تقدر تتغيره Pictures1.rar

الشكر كله لله

اتفضل انا عملت لك هذه القاعدة اولا حدد فتح نموذجك في وضع تصميم بعدين حدد كل الحقول بعدين اعمل كما في الصورة والنتيجة اليك القاعدة Database1.rar

اليك هذا On Error Resume Next Dim R As String R = Forms![بحث عن سند إيرادات]![تابع132]![رقم السند] If DLookup("[تعديل سند إيرادات]", "TB5", "[NAME]='" & Me.user1 & "'") = False Then MsgBox "ليس لديك صلاحيه بالتعديل" ElseIf DLookup("[تعديل سند إيرادات]", "TB5", "[NAME]='" & Me.user1 & "'") = True And R > 1 Then DoCmd.OpenForm "تعديل سند إيرادات", acNormal, , "[رقم السند]='" & R & "'" Else MsgBox "ادخل رقم السند المطلوب تعديله" End If تعديل السندات.rar

السلام عليكم ورحمة الله وبركاته اخي محمد اهلا بك اخي @sandanet شکرا لک لانک ردیت علێ اخونا محمد واهلا بك اخي محمد مع اخوتك في منتداك مثلا اتمنى لك التوفيق اخوك شفان ريكاني هذه اسم فانكشن اي هذا الاسم هو فقط الاسم والجزء الكبير للكود محفوظة في وحدة نمطية اي يعني يجب ان يكون هناك وحدة نمطية موجودة لكي نقدر نستخدمه تقدر ان تغير اسم الفانكشن بما تشاء واحتمال ان يكون هناك وحدة نمطية اخرى لكي يعمل ذلك استاذنا @sandanet اعطاك رابط بها اكثر ما تريد وفي الاخير ابحث في المنتدى اكثر ما تريد فقط ابحث عن ما تريد تقبل تحياتي

استأذن من استاذنا @محمدنجار انت کان استخدمت مع الکود کلمە و ولیس او الیک الکود Private Sub كود_الصنف_AfterUpdate() 'On Error Resume Next If Forms![فاتوره شراء]!التوجيه = "بيع" Or Forms![فاتوره شراء]!التوجيه = "مرتجع بيع" Then Me.السعر = Me.سعر_البيع ElseIf Forms![فاتوره شراء]!التوجيه = "شراء" Or Forms![فاتوره شراء]!التوجيه = "مرتجع شراء" Or Forms![فاتوره شراء]!التوجيه = "تحويل" Then Me.السعر = Me.سعر_الشراء End If End Sub وھذا ملفك بعد تعديل 1111111.rar

هذا الاستعلام سيعطيك سجلات اللي مر عليه اكثر من 30 دقيقة SELECT السجل.id, السجل.a, السجل.b, ((Format(Hour([b]),"00")-Format(Hour([a]),"00"))*60)+Format(Minute([b]),"00")-Format(Minute([a]),"00") AS DDDD FROM السجل WHERE (((((Format(Hour([b]),"00")-Format(Hour([a]),"00"))*60)+Format(Minute([b]),"00")-Format(Minute([a]),"00"))>30)); وهذا سيعطيك عدد السجلات اللي مره عليه اكثر من 30 دقيقة SELECT Count(السجل.id) AS CountOfid FROM السجل WHERE ((((((Format(Hour([b]),"00")-Format(Hour([a]),"00"))*60)+Format(Minute([b]),"00")-Format(Minute([a]),"00")))>30)); واليك المرفق بها استعلامين حساب الوقت.rar