برجاء تصحيح كود خاص بالتصدير للورد

[m_fouad0003]

بسم  الله الرحمن الرحيم

    LWordDoc.Visible = True
    LWordDoc.ActiveDocument.Bookmarks("A1").Select
    LWordDoc.Selection.InsertAfter b1
    LWordDoc.ActiveDocument.Bookmarks("A2").Select
    LWordDoc.Selection.InsertAfter b2
    LWordDoc.ActiveDocument.Bookmarks("A3").Select
    LWordDoc.Selection.InsertAfter b3
    LWordDoc.ActiveDocument.Bookmarks("A4").Select
    LWordDoc.Selection.InsertAfter b4
    LWordDoc.ActiveDocument.Bookmarks("A5").Select
    LWordDoc.Selection.InsertAfter b5
LWordDoc.Application.Documents(Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx").Save
LWordDoc.Quit
    Set LWordDoc = Nothing
 هذا الكود يقوم موجود فى زر امر ويقوم بتصدير السجل الحالى فقط الى الورد 

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

[ابو البشر]

منذ ساعه, m_fouad0003 said:

بسم  الله الرحمن الرحيم

    LWordDoc.Visible = True
    LWordDoc.ActiveDocument.Bookmarks("A1").Select
    LWordDoc.Selection.InsertAfter b1
    LWordDoc.ActiveDocument.Bookmarks("A2").Select
    LWordDoc.Selection.InsertAfter b2
    LWordDoc.ActiveDocument.Bookmarks("A3").Select
    LWordDoc.Selection.InsertAfter b3
    LWordDoc.ActiveDocument.Bookmarks("A4").Select
    LWordDoc.Selection.InsertAfter b4
    LWordDoc.ActiveDocument.Bookmarks("A5").Select
    LWordDoc.Selection.InsertAfter b5
LWordDoc.Application.Documents(Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx").Save
LWordDoc.Quit
    Set LWordDoc = Nothing
 هذا الكود يقوم موجود فى زر امر ويقوم بتصدير السجل الحالى فقط الى الورد 

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

هذا الكود فيه نقص ... الرجاء ارفاق مثال للتعديل عليه ...

[m_fouad0003]

اشكرك اخى على اهتمامك ومرفق المثال للتعديل

تصدير للورد.accdb

[Barna]

جرب التعديل وانتظر حتى ظهور الرسالة ......

Dim MWordDocCopyOf        As String
Dim NWordDocCopyOf        As String
Dim LWordDocOriginal      As String
Dim LWordDocCopyOf        As String
Dim Warning               As String

DoCmd.GoToRecord , , acFirst
    For i = 1 To Me.Recordset.RecordCount
If Dir(CurrentProject.Path & "\" & Me.المعرف & "\", vbDirectory) <> "" Then
Else
 MkDir CurrentProject.Path & "\" & Me.المعرف & "\"
End If
    
    LWordDocOriginal = CurrentProject.Path & "\asd.docx"
    LWordDocCopyOf = CurrentProject.Path & "\" & Me.المعرف & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
 If IsFileLocked(LWordDocCopyOf) = True Then
    MsgBox "يرجى غلق ملف الوورد!"
    Application.FollowHyperlink LWordDocCopyOf
  Exit Sub
 Else
        FileCopy LWordDocOriginal, LWordDocCopyOf
        MWordDocCopyOf = LWordDocCopyOf
        NWordDocCopyOf = Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
Dim LWordDoc As Object
Set LWordDoc = CreateObject("Word.Application")

    LWordDoc.Documents.Open MWordDocCopyOf
    LWordDoc.Visible = True
    LWordDoc.ActiveDocument.Bookmarks("A1").Select
    LWordDoc.Selection.InsertAfter Nz(b1.Value, "")
    LWordDoc.ActiveDocument.Bookmarks("A2").Select
    LWordDoc.Selection.InsertAfter Nz(b2.Value, "")
    LWordDoc.ActiveDocument.Bookmarks("A3").Select
    LWordDoc.Selection.InsertAfter Nz(b3.Value, "")
    LWordDoc.ActiveDocument.Bookmarks("A4").Select
    LWordDoc.Selection.InsertAfter Nz(b4.Value, "")
    LWordDoc.ActiveDocument.Bookmarks("A5").Select
    LWordDoc.Selection.InsertAfter Nz(b5.Value, "")
    LWordDoc.Application.Documents(NWordDocCopyOf).Save
End If
    LWordDoc.Quit
    Set LWordDoc = Nothing

DoCmd.GoToRecord , , acNext
    Next i
Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbOKOnly, "تنبيه")

 

[m_fouad0003]

اخى الكريم أولا بارك الله فيك 

ثانيا الكود الخاص بك يقوم بعمل ملف ورد لكل سجل والمطلوب ان تخرج كل السجلات فى ملف ورد واحد 

ارجو تعديل الكود ولحضرتك جزيل الشكر مقدما

[kanory]

في 22‏/6‏/2022 at 00:10, m_fouad0003 said:

اخى الكريم أولا بارك الله فيك 

ثانيا الكود الخاص بك يقوم بعمل ملف ورد لكل سجل والمطلوب ان تخرج كل السجلات فى ملف ورد واحد 

ارجو تعديل الكود ولحضرتك جزيل الشكر مقدما

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

Dim DstFile        As String
    DstFile = CurrentProject.Path & "\" & Format(Now, "hhmmss") & ".doc"
    DoCmd.OutputTo acOutputTable, "tabasd", "RichTextFormat(*.rtf)", DstFile, True, "", 0, acExportQualityPrint

 

[Barna]

حياك الله اخي الغالي @kanory اهلا شرفتنا ...

دائما الاستاذ يبقى استاذ .... منكم نتعلم استاذي الكريم .... شكرا لمرورك 

[kanory]

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

حياك الله اخي الغالي @kanory اهلا شرفتنا ...

دائما الاستاذ يبقى استاذ .... منكم نتعلم استاذي الكريم .... شكرا لمرورك 

العين لا تعلو على الحاجب .....

عارف حتقول اذا كان الشخص مقلوب ..... هههههههه