سامي الحداد

الإثنين at 18:58

تفضل استاذ @jo_2010 هذا بالنسبة لطلبك الثاني

Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    On Error Resume Next
    
    If Not Me.Dirty Then
        If (Count < 0) And (Me.CurrentRecord > 1) Then
            DoCmd.GoToRecord , , acPrevious
        ElseIf (Count > 0) And (Me.CurrentRecord <= Me.Recordset.RecordCount) Then
            DoCmd.GoToRecord , , acNext
        End If
        Dim parentForm As Form
        Dim labReqForm As Form
        Dim pnameValue As String
        Dim recordFound As Boolean
        
        Set parentForm = Me.Parent
        If parentForm.Controls("Lab_Patient").Form.CurrentView = 0 Then
            MsgBox "Lab_Patient subform is not open."
            Exit Sub
        End If
        
        Set labReqForm = parentForm.Controls("Lab_Sub_REQ").Form
        pnameValue = parentForm.Controls("Lab_Patient").Form.Controls("PNAME").Value
        labReqForm.Recordset.FindFirst "Pname = '" & pnameValue & "'"
        
        If Not labReqForm.Recordset.NoMatch Then
            labReqForm.Controls("Requests").BackColor = RGB(255, 0, 0)
            recordFound = True
        Else
'            MsgBox "Record not found in Lab_Sub_REQ."
            recordFound = False
        End If
    End If
End Sub

بالتوفيق

LAB_GOOD 2.rar

الإثنين at 15:57

20 ساعات مضت, waheidi2005 said:

اخي الكريم هل هناك مجال عند تسجيل غياب لنفس الطالب في تاريخ مختلف ان تكون خانة ملاحظات فارغة مثل ما يتم تفريغ مربع الاختيار وبارك الله فيك

نعم تفضل اخي الكريم

Private Sub أمر63_Click()
    DoCmd.SetWarnings False
    DoCmd.RunSQL "INSERT INTO TBLgiab (MainId, stclass, sttype, StName, remarks, G_date) " & _
             "SELECT student.Stno, student.Stclass, student.sttype, student.StName, student.empty, " & _
             "[forms]![frmgiab]![Text40] AS Expr1 FROM student WHERE student.ck = True;"
    DoCmd.RunSQL "UPDATE student SET student.ck = 0, student.Empty = Null;"
    DoCmd.SetWarnings True
    Forms![FrmGiab]![نموذج فرعي TBLgiab1].Form.Requery
End Sub

بالتوفيق

April 2

الان انتبهت انك غيرت طلبك .

هذا طلبك الاول : وقد رايت كود الاستاذ @AlwaZeeR وهو يعمل بكفاءه.

في 1‏/4‏/2024 at 19:29, شامل2 said:

كيف يمكن عرض الصور والمستندات المصورة في المثال بامتدادات مختلفة.

بعض الصور امتدادها jpg يتم عرضها والاخر امتدادها png لا تعرض

في 1‏/4‏/2024 at 20:18, شامل2 said:

وكيف يمكن استدعاء الصور اذا كانت في اكثر من مجلد؟

وهدا طلبك الثاني : هل هو المطلوب ام ان هناك تغير ثالث؟ أخي الكريم انت عضو فضي وتعرف قوانين المنتدى .

على العموم قمت بتغير الكود للتالي فقط الغي الكود السابق وضع هذا الكود

Private Sub Form_Current()
    Dim Psh As String
    Dim fileName As String
    Dim folderPath As String
    Dim folderName As Variant
    
    On Error GoTo Err
    
    fileName = [ID]
    
    Dim folders() As String
    folders = Split("picto,picto1,Picto2", ",")
    
    For Each folderName In folders
        folderPath = CurrentProject.Path & "\" & folderName & "\"
        
        If Dir(folderPath & fileName & ".jpg") <> "" Then
            Psh = folderPath & fileName & ".jpg"
            Exit For ' Exit loop once file is found
        ElseIf Dir(folderPath & fileName & ".png") <> "" Then
            Psh = folderPath & fileName & ".png"
            Exit For
        End If
    Next folderName
    
    pic.Picture = Psh
    
    Exit Sub
    
Err:
    pic.Picture = ""
    Exit Sub
End Sub

تحياتي

April 2

في 1‏/4‏/2024 at 19:29, شامل2 said:

كيف يمكن عرض الصور والمستندات المصورة في المثال بامتدادات مختلفة.

بعض الصور امتدادها jpg يتم عرضها والاخر امتدادها png لا تعرض

وعليكم السلام

مشاركة مع الاساتذة بازك الله فيهم هل هذا هو المطلوب ؟

Private Sub Form_Current()
    Dim Psh As String
    Dim filePath As String
    Dim fileName As String
    
    On Error GoTo Err
    
    fileName = [ID]
    filePath = CurrentProject.Path & "\picto\" & fileName
    
    If Dir(filePath & ".jpg") <> "" Then
        Psh = filePath & ".jpg"
    ElseIf Dir(filePath & ".png") <> "" Then
        Psh = filePath & ".png"
    Else
        Psh = ""
    End If
    
    pic.Picture = Psh
    
    Exit Sub
    
Err:
    pic.Picture = ""
    Exit Sub
End Sub

والملف بعد التعديل

التعامل مع الصور 2.rar

مارس 26

أحسنت وأحسن الله اليك اخي الاستاذ @Foksh

بالفعل لقد فاتتني الاشارة الى المكتبات ونسخة 64 لان الاخ @UserUser2 كان بالفعل قد استخدم الطابعة الافتراضية لان ملفه كانت المكتبات موجودة بالفعل ولهذا لم افكر بالامر😄

اشكرك جزيل الشكر اخي الفاضل على هذه الاضافات ربي يسعدك.

مارس 26

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

تفضل اخي الكريم @UserUser2

تم تنفيذ الخطوات التالية:

1. سيتم إنشاء مجلد "Documents" بجانب قاعدة البيانات.

2. سيتم إنشاء مجلد "PDF" تحت مجلد "Documents".

3. سيتم إنشاء مجلد "JPEG" تحت مجلد "Documents".

الغرض من إنشاء هذه المجلدات هو تلبية طلب الأخ السائل، الذي رغب في حفظ الصورة عند التصدير في مجلد محدد برقم العميل واسم الصورة تحمل اسم العميل والتاريخ الموجود في النموذج. ونظرًا لصعوبة تنفيذ هذا الطلب بالنسبة للصور بواسطة برنامج وسيط ، اما بالنسبة للــ PDF فآمره سهل جدا وهو ما تم عمله اولا فقد تم تنفيذ الخطوات التالية بعد إنشاء المجلدات:

1. يتم حفظ الملف بالأسماء المذكورة والتاريخ بصيغة PDF.

2. يتم إرسال الملف للطابعة الافتراضية "Universal Documents Converter".

3. يتم تحديد الصيغة المطلوبة، وفي حالتنا نريد صيغة الصور JPEG.

4. يتم إنشاء الملف المطلوب بكلا الصيغتين PDF و JPEG.

5. يتم حفظ الملف تحت المجلد الخاص به.

الاكواذ المستخدمة

Option Compare Database
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub CmdPrint_Click()
    Dim Fs As Object
    Dim StrFolder As String, FilePathPDF As String, FileName As String

    Set Fs = CreateObject("Scripting.FileSystemObject")
    StrFolder = CurrentProject.Path & "\Documents"
    If Not Fs.FolderExists(StrFolder) Then
        On Error Resume Next
        Fs.CreateFolder StrFolder
        On Error GoTo 0
        If Err.Number <> 0 Then
            MsgBox "حدث خطأ أثناء إنشاء المجلد الرئيسي: " & Err.Description, vbCritical + vbOKOnly, "خطأ"
            Err.Clear
            Exit Sub
        End If
    End If

    Dim PDFFolder As String
    PDFFolder = StrFolder & "\PDF"
    If Not Fs.FolderExists(PDFFolder) Then
        On Error Resume Next
        Fs.CreateFolder PDFFolder
        On Error GoTo 0
        If Err.Number <> 0 Then
            MsgBox " PDF خطأ في إنشاء مجلد فرعي " & Err.Description, vbCritical + vbOKOnly, "خطأ"
            Err.Clear
            Exit Sub
        End If
        MsgBox "الفرعي بنجاح PDF تم إنشاء المجلد", vbInformation + vbOKOnly, "تأكيد"
    End If

    FileName = Me.ID & " - " & Me.CNo & " - " & Me.CName & " - " & Format([iDate], "dd-mm-yyyy")
    FilePathPDF = PDFFolder & "\" & FileName & ".PDF"
    
    DoCmd.OpenReport "Report1", acViewPreview, , "[ID] = " & Me.ID
    DoCmd.OutputTo acOutputReport, "Report1", acFormatPDF, FilePathPDF, False
    DoCmd.Close acReport, "Report1", acSaveNo

    ShellExecute 0, "Open", FilePathPDF, vbNullString, vbNullString, vbNormalFocus
    ShellExecute 0, "Print", FilePathPDF, vbNullString, vbNullString, vbNormalFocus
    
    Dim JPEGFolder As String
    JPEGFolder = StrFolder & "\JPEG"
    If Not Fs.FolderExists(JPEGFolder) Then
        On Error Resume Next
        Fs.CreateFolder JPEGFolder
        On Error GoTo 0
        If Err.Number <> 0 Then
            MsgBox " JPEG خطأ في إنشاء مجلد فرعي  " & Err.Description, vbCritical + vbOKOnly, "خطأ"
            Err.Clear
            Exit Sub
        End If
        MsgBox "الفرعي بنجاح JPEG تم إنشاء المجلد", vbInformation + vbOKOnly, "تأكيد"
    End If
End Sub

بالنسبة للطابعة يجب ان تحفظ اعدادت موقع حفظ الملف Documents \Jpeg مثال : C:\Users\LENOVO\Downloads\TEST IMAGE\Documents\JPEG

وهذا هو المرفق

بالتوفيق

TEST IMAGE 2.rar

مارس 26

10 ساعات مضت, طير البحر said:

ان طلبي محدد من البداية الصفخات الفارغة اى يجب ان تكون فارغة من اى محتوى

اخي الكريم

وهذا ما عملته بالضبط يجب ان تكون الصفحة خالية تماما من اي محتوى،،، والكود يقوم بهذه المهة فقط.

سؤال هل فعلا جربت الكود لإني على يقين حضرتك لم تجرب الكود. وإلا لكان رأيت عمل الكود بالضبط.

الاخوة الكرام من يستطيع ان يجرب الكود ويعلمني اذا كان يعمل او لا . ربما اكون مخطئ.

وهذا الكود مرة اخرى

Option Compare Database
Option Explicit
Private Sub Command0_Click()
     CleanUpWordDocument
End Sub
Public Function DeleteBlankPages(wd As Word.Document)
    Dim par As Paragraph
    For Each par In wd.Paragraphs
        If Len(par.Range.Text) <= 1 Then
            par.Range.Delete
        End If
    Next par
End Function
Public Sub CleanUpWordDocument()
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Set wdDoc = wdApp.Documents.Open("C:\Users\LENOVO\Documents\Test1.docx")' استبدل المسار 
    
    DeleteBlankPages wdDoc
    MsgBox "تمت عملية حذف الصفحات الفارغة", vbInformation + vbMsgBoxRight, "تأكيد"
    wdDoc.Save
    wdDoc.Close
    wdApp.Quit
    
    Set wdDoc = Nothing
    Set wdApp = Nothing
End Sub

مارس 25

11 ساعات مضت, طير البحر said:

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

أخي الكريم طلبك كان حذف الصفحات الفارغة من ملف وورد برمجيا .

وهذا ما تم عمله لحذف الصفحات الفارغه ولا له علاقة بطلبك الثاني . سوف اتوقف هنا.

تحياتي

مارس 25

اخي الكريم اسف على التاخير سوف انظر في المرفق غدا ان شاءالله تعالى

مارس 24

19 ساعات مضت, kkhalifa1960 said:
 
اقرأ هذا المحتوي ونزل الطابعة (How to Convert Access Report to JPEG)

15 ساعات مضت, Foksh said:

انا عن نفسي استخدم الطريقة التي أشار إليها الاستاذ خليفة

هلا بالشباب هذا هو نفس البرنامج الوسيط الذي استخدمته انظروا لمشاركتي السابقة لقد عملت فيديو والملف المرفق مع الاكواد.

مارس 24

14 ساعات مضت, UserUser2 said:

مثل الكود ده بدل ماهو PDF يكون صوره

اخي الكريم

ارفق ملفك للتعديل عليه وأبشر خيرا ان شاءالله

مارس 24

4 ساعات مضت, طير البحر said:

للاسف لم يؤدي الكود الوظيفة المرجوة

عجيب كيف لم يؤدي الوظيفة؟ الا اذا كنت تقصد شيئا اخر ! ملاحظة برنامج Word يجب ان يكون مفلقا حتى يتم عمل الكود.

انظر للفيديو المرفق

Delete Empty Word Pages.rar

مارس 23

السلام عليكم ورحمة الله وبركاته
بالإضافة لما تفضل به الأستاذ موسى جزاه الله خيرا
انا استخدم هذا البرنامج Universal Document Converter وهذا موقع الشركة: https://www.print-driver.com/download
بعد إتمام عملية تنصيب البرنامج تابع الفيديو . ومرفق ملفك بعد التعديل.

بالتوفيق

jpg.rar شرج عمل برنامج Universal Document Converter.rar

مارس 23

السلام عليكم

هذه مشاركتي مع الاخوة الكرام.

Option Compare Database
Option Explicit

Private Sub Command0_Click()
     CleanUpWordDocument
End Sub
Public Function DeleteBlankPages(wd As Word.Document)
    Dim par As Paragraph
    For Each par In wd.Paragraphs
        If Len(par.Range.Text) <= 1 Then
            par.Range.Delete
        End If
    Next par
End Function

Public Sub CleanUpWordDocument()
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Set wdDoc = wdApp.Documents.Open("C:\Users\LENOVO\Documents\Test1.docx")' استبدل المسار 
    
    DeleteBlankPages wdDoc
    MsgBox "تمت عملية حذف الصفحات الفارغة", vbInformation + vbMsgBoxRight, "تأكيد"

    wdDoc.Save
    wdDoc.Close
    wdApp.Quit
    
    Set wdDoc = Nothing
    Set wdApp = Nothing
End Sub

بالتوفيق

مارس 22

اللهم آمين وإياك إن شاء الله، الله يجعلك من اهل الجنة ويرحم والديك في الدنيا والاخرة

الشكر لله عز وجل ربي يسعدك.

مارس 21

مشاركة مع الاخ @Foksh

Option Compare Database
Option Explicit

Private Sub Command0_Click()
    ExecuteIfChromeOpen
End Sub

Function IsChromeRunning() As Boolean
    Dim strCommand As String
    Dim strOutput As String
    Dim objWShell As Object
    Set objWShell = CreateObject("WScript.Shell")
    
    strCommand = "tasklist /FI ""IMAGENAME eq chrome.exe"""
    
    strOutput = objWShell.Exec(strCommand).StdOut.ReadAll
    
    If InStr(strOutput, "chrome.exe") > 0 Then
        IsChromeRunning = True
    Else
        IsChromeRunning = False
    End If
    
    Set objWShell = Nothing
End Function


Sub ExecuteIfChromeOpen()
    If IsChromeRunning() Then
        MsgBox " المتصفح كروم قيد التشغيل. سيتم تنفيذ الأمر", vbInformation, "تأكيد"
        DoCmd.OpenForm "البيانات"
    Else
        MsgBox "يجب فتح المتصفح .", vbExclamation, "المتصفح مغلق"
    End If
End Sub

واليك المرفق

بالتوفيق

Database313.accdb

مارس 21

هل هذا هو المطلوب ؟

23 ساعات مضت, طير البحر said:

لكني اريد تحميل الملف عبر الكود ببساطة

حسب ما فهمت هل هذا هو المطلوب؟

Private Sub Form_Load()
    
    Dim pdfPath As String
    pdfPath = "C:\Users\LENOVO\Documents\1222.pdf" ' استبدل المسار  
    Me.WebBrowser0.Object.Navigate pdfPath
    
End Sub

مارس 21

نعم ممكن عملها كما عملت وهذه طريقتي اليك التعديل

Public Sub ExtractImage()
    Dim Db As DAO.Database
    Dim Rs_p As DAO.Recordset2
    Dim Rs_c As DAO.Recordset2

    Dim sPath As String
    Dim sFile As String
    Dim SpecificFileName As String

    SpecificFileName = "Image1"
    sPath = CurrentProject.Path & "\Images\"

    Set Db = CurrentDb

    Set Rs_p = Db.OpenRecordset("SELECT * FROM MsysResources WHERE [type]='img' AND [Name]='" & SpecificFileName & "';", dbOpenDynaset)

    With Rs_p
        If Not (.BOF And .EOF) Then
            .MoveFirst

            MKDir sPath

            Do Until .EOF
                Set Rs_c = .Fields("Data").Value

                sFile = sPath & .Fields("Name") & "." & .Fields("Extension")
                If Len(Dir$(sFile)) <> 0 Then
                    Kill sFile
                End If

                Rs_c.Fields("FileData").SaveToFile sFile

                Set Rs_c = Nothing

                .MoveNext
            Loop
            MsgBox "    : تمت عملية إستخراج الصور الى   " & sPath, vbInformation + vbMsgBoxRight, "تأكيد"
        End If
        .Close
    End With

    Set Rs_p = Nothing
    Set Db = Nothing

End Sub

Public Sub MKDir(ByVal sPath As String)
    Dim var As Variant, v As Variant
    Dim sPth As String

    var = Split(sPath, "\")

    On Error Resume Next

    For Each v In var
        sPth = sPth & v
        VBA.MKDir sPth
        sPth = sPth & "\"
    Next v

End Sub

بالتوفيق

مارس 21

5 ساعات مضت, طير البحر said:

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

نعم ممكن اليك الكود

Option Compare Database
Option Explicit

Private Sub Command2_Click()
    ExtractImage
End Sub

Public Sub ExtractImage()

    Dim Db As DAO.Database
    Dim Rs_p As DAO.Recordset2
    Dim Rs_c As DAO.Recordset2
    
    Dim sPath As String
    Dim sFile As String
    
    sPath = CurrentProject.Path & "\Images\"
    
    Set Db = CurrentDb
    
    Set Rs_p = Db.OpenRecordset("select * from MsysResources where [type]='img';", dbOpenDynaset)
    
    With Rs_p
        If Not (.BOF And .EOF) Then
            .MoveFirst
            MKDir sPath
      
            Do Until .EOF
                Set Rs_c = .Fields("Data").Value
                
                sFile = sPath & .Fields("Name") & "." & .Fields("Extension")
                If Len(Dir$(sFile)) <> 0 Then
                    Kill sFile
                End If
                
                Rs_c.Fields("FileData").SaveToFile sFile
            
                Set Rs_c = Nothing
                
                .MoveNext
            Loop
            MsgBox "    : تمت عملية إستخراج الصور الى   " & sPath, vbInformation, "تأكيد"
        End If
        .Close
    End With
    
    Set Rs_p = Nothing
    Set Db = Nothing
            
End Sub

Public Sub MKDir(ByVal sPath As String)
    Dim var As Variant, v As Variant
    Dim sPth As String
    
    var = Split(sPath, "\")
    
    On Error Resume Next
    
    For Each v In var
        sPth = sPth & v
        VBA.MKDir sPth
        sPth = sPth & "\"
    Next v

End Sub

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

وهذا ملفك مع الكود وتم إضافة ايقونات 2 للتجربة

بالتوفيق

saveimage2.accdb

مارس 19

أخي انت لم تستخدم الكود الذي ذكرته لك وحتى لم تكلف نفسك بتجربته

على العموم نفس الكود اعلاه يعمل. فقط كلف نفسك وانقله الى ملفك يعني نسخ ولصق .

وهذا ملفك مع نفس الكود اعلاه

error (1).accdb

مارس 17

وعليكم السلام

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

Private Sub Command0_Click()
    Dim Result As Variant
    Result = DLookup("feq", "test_tbl")
    
    If Len(Result & "") = 0 Then
        MsgBox "Equation not found or is empty.", vbExclamation
    Else
        If IsNumeric(Result) Then
            Me.E = Result
        Else
            Me.E = DLookup("result", "test_order_tbl", "[tcode] = 17") / DLookup("result", "test_order_tbl", "[tcode] = 16")
        End If
    End If
End Sub

بالتوفيق

فبراير 16

مشاركة مع الاساتذة جرب هذا التعديل


Private Sub Command84_Click()
    Dim cityCode As String
    Dim strSQL As String

    ' استخراج كود المدينة من المربع النصي
    cityCode = Me.Text82.Value
    
    ' التحقق من أن تم إدخال كود المدينة
    If Len(cityCode) > 0 Then
        ' نقل السجلات المستهدفة إلى جدول مؤقت "Test"
        strSQL = "SELECT * INTO Test FROM [BASIC_DATE] WHERE Left(crn, 4) = '" & cityCode & "';"
        DoCmd.RunSQL strSQL

        ' Delete4
        strSQL = "UPDATE Test SET crn = Right(crn, Len(crn)-4) WHERE Left(crn, 4) = '" & cityCode & "';"
        DoCmd.RunSQL strSQL
        
        ' Delete3 right
        strSQL = "UPDATE Test SET crn = Left(crn,Len(crn)-3) & Right(crn,2) WHERE Left(crn, 4) = '" & cityCode & "';"
        DoCmd.RunSQL strSQL
        
        ' Repete
        strSQL = "UPDATE Test SET crn = Left([crn],2)+[crn] WHERE Left(crn, 4) = '" & cityCode & "';"
        DoCmd.RunSQL strSQL
        
        ' Addo
        strSQL = "UPDATE Test SET crn = crn & '00' WHERE Left(crn, 4) = '" & cityCode & "';"
        DoCmd.RunSQL strSQL

        ' حذف السجلات من الجدول الأصلي "BASIC_DATE"
        DoCmd.RunSQL "DELETE FROM [BASIC_DATE] WHERE Left(crn, 4) = '" & cityCode & "';"

        ' إدراج السجلات المحدثة من "Test" إلى الجدول الأصلي "BASIC_DATE"
        DoCmd.RunSQL "INSERT INTO [BASIC_DATE] SELECT * FROM Test;"

        ' حذف الجدول المؤقت "Test"
        DoCmd.DeleteObject acTable, "Test"

        ' رسالة تأكيد
        MsgBox "تم تحديث السجلات بنجاح!", vbInformation
        DoCmd.Requery
    Else
        ' رسالة في حالة عدم إدخال كود المدينة
        MsgBox "الرجاء إدخال كود المدينة أولاً!", vbExclamation
    End If
End Sub

فبراير 10

7 ساعات مضت, blue sea said:

مشكور اخي الكريم .. لو ممكن عرض بيانات السجل المكرر المذكور في نموذج الادخال بعد ظهور الرسالة

مشاركة مع الاستاذ @SAROOK جزاه الله خيرا

Private Sub document_name_AfterUpdate()

    Dim Msg, Style, Title, Response
    Dim XX As Variant
    XX = [document name]
    If (Eval("dlookup(""[document name]"",""[input]"",""[nomber] =form![document name]"") Is Not Null")) Then
              
        Msg = "الكتاب رقم" & " " & XX & " " & vbCrLf & _
               "قد تم ادخاله سابقا " & vbCrLf & vbCrLf & _
               "Yes : نعم اذهب الى ذلك السجل" & vbCrLf & _
               "No  : فقط الغي هذا السجل"
        Style = vbYesNo + vbCritical + vbDefaultButton2 + vbMsgBoxRight
        Title = "تحذير الرقم مكرر !! "
                
        Response = MsgBox(Msg, Style, Title)
        If Response = vbYes Then
'        DoCmd.GoToControl "document name"
        DoCmd.FindRecord XX, , , , , acAll, True
        End If
    Me.Undo
End If
End Sub

وهذا الملف بعد التعديل

بالتوقيق

abcd.rar

فبراير 9

الشكر لله عز وجل

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

تحياتي

فبراير 9

وعليكم السلام

تفضل اخي الكريم

Private Sub Cmdshow_Click()
    Me.txt = ""
    Me.Form.RecordSource = ""
    
Me.Form.RecordSource = "SELECT * FROM Qtb "
Me.Form.RecordSource = "Qtb"
End Sub

واليك الملف بعد التعديل

test (2).accdb

تسجيل الدخول

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه سامي الحداد

Important Information