طلب دمج كود نقل السجلات مع تصدير البيانات

[samisalim]

تكملة لموضوعي السابق في الرابط التالي https://www.officena.net/ib/topic/109973-مساعدة-في-كود-نقل-السجلات/

وكل الشكر والتقدير للأستاذ kanory على المساعدة

On Error Resume Next
Me.Refresh

TimerId = SetTimer(0, 0, 1, AddressOf TimerProc)
    str_Title = "كلمة المرور"
If InputBox("ادخل كلمة المرور") <> 123 Then
Cancel = True
Exit Sub
Else

Dim i
i = Me.IDED
If MsgBox("هل تريد إحلال الاجهزة وطباعة الإستمارة؟", _
    vbCritical + vbYesNo, _
    "") = vbNo Then
 Exit Sub
 Else
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO EMPDEV_ARCHIVES ( IDED, IDE, IDD, DATEG, STATUS, SystemS, NOTES2, DATER, RECEIPT, NOTES, IDD1, IDD2 ) " & vbCrLf & _
"SELECT EMPDEV.IDED, EMPDEV.IDE, EMPDEV.IDD, EMPDEV.DATEG, EMPDEV.STATUS, EMPDEV.SystemS, EMPDEV.NOTES2, EMPDEV.DATER, EMPDEV.RECEIPT, EMPDEV.NOTES, EMPDEV.IDD1, EMPDEV.IDD2 " & vbCrLf & _
"FROM EMPDEV " & vbCrLf & _
" WHERE (((EMPDEV.Choix)=True));"
DoCmd.OutputTo acOutputReport, "EMPDEVMENU", acFormatPDF, strPathAndfile, True
DoCmd.RunSQL "DELETE EMPDEV.Choix, EMPDEV.* " & _
" FROM EMPDEV " & _
" WHERE (((EMPDEV.Choix)=True));"
DoCmd.SetWarnings True
End If
End If
 Me.Requery
end sub

لكن تظهر هذه المشكلة

 

1-عند الضغط على OK يتم التصدير ولكن لايتم حذف السجلات المحددة في النموذج

2-عند الضغط على Cancel يتم حذف السجلات

[د.كاف يار]

تفضل التعديل

 

 

Test_It_0001.zip

[samisalim]

استاذي العزيز @د.كاف ياركفيت ووفيت وجوزيت جنة الفردوس وعيدك مبارك

استاذي هل ممكن اضافة كود التصديرPdf في زر إرجاع وطباعة استمارة ويقوم بتخزين المستند بإسم احلال الاجهزة مع التاريخ مع امكانية طباعته ؟؟؟

اكون ممتن لك

تم تعديل يوليو 19, 2021 بواسطه samisalim

[د.كاف يار]

تفضل التعديل

 

2Test_It_0001.zip

[samisalim]

منذ ساعه, د.كاف يار said:

تفضل التعديل

 

2Test_It_0001.zip 962.3 kB · 1 download

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

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

[samisalim]

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

Sub Trans()
On Error Resume Next

    Dim db As DAO.Database
    Dim rs, rs2 As DAO.Recordset
    
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM SCDEV where Choix=-1")
    Set rs2 = CurrentDb.OpenRecordset("SCDEV_ARCHIVES")
    
    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        While (Not rs.EOF)
        If rs.Fields(13) = -1 Then
            rs2.AddNew
            rs2![IDED] = rs.Fields(0)
            rs2![IDS] = rs.Fields(1)
            rs2![Location] = rs.Fields(2)
            rs2![IDD] = rs.Fields(3)
            rs2![DATEG] = rs.Fields(4)
            rs2![STATUS] = rs.Fields(5)
            rs2![SystemS] = rs.Fields(6)
            rs2![NOTES2] = rs.Fields(7)
            rs2![DATER] = rs.Fields(8)
            rs2![RECEIPT] = rs.Fields(9)
            rs2![NOTES] = rs.Fields(10)
            rs2![IDD1] = rs.Fields(11)
            rs2![IDD2] = rs.Fields(12)
            rs2![Choix] = -1
            rs2.Update
            rs.Delete
          End If
            rs.MoveNext
        Wend
    End If
    Dim sSQL As String
    rs.Close
    Set rs = Nothing
     DoCmd.Requery
    Set db = CurrentDb
        sSQL = "UPDATE SCDEV SET choix=false; "
        db.Execute sSQL

    
End Sub
Sub ExportReport()
On Error Resume Next

Dim fso As Object
Dim fldrname As String
Dim fldrpath As String
Set fso = CreateObject("scripting.filesystemobject")
          fldrpath = CurrentProject.Path & "\احلال الاجهزة"
          If Not fso.FolderExists(fldrpath) Then
             fso.createfolder (fldrpath)

          End If
Dim DstFile As String
DstFile = CurrentProject.Path & "\احلال الاجهزة\احلال الاجهزة-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ").pdf"

DoCmd.OutputTo acOutputReport, "SCDEVMENU", "PDFFormat(*.pdf)", DstFile, True ', "", , acExportQualityPrint

End Sub

 

School_It_0001.rar

[د.كاف يار]

الغي كود التحديث الموجود في حدث عن الفتح في التقرير 

لأني وضعت الكود لك ضمن كود تصدير البيانات

 

اتفضل التعديل

111School_It_0001.zip

[samisalim]

6 ساعات مضت, د.كاف يار said:

الغي كود التحديث الموجود في حدث عن الفتح في التقرير 

لأني وضعت الكود لك ضمن كود تصدير البيانات

 

اتفضل التعديل

111School_It_0001.zip 1006.47 kB · 1 download

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