(طلب) تعديل على كود تصدير حقول إلى الوورد

[ابوبسمله]

1 ساعه مضت, مبرمج سابق said:

وعالم متخفي

صحيح معلمنا العزيز وانتظره ع قائمه الخبراء هو وبعض الاخوه ما شاء الله عليهم ربنا يباركلنا فيهم

 

[عمر ضاحى]

في 17‏/6‏/2022 at 22:38, ابو البشر said:

كل هذا ممكن .... بس خلينا نخلص من اخونا @حامل المسك

 

^_^

ابشر ان شاء الله اتحلت 

نجرب نعدل على الكود بحث يعمل مجلدات جديده باسم الموظف (رقم ID)

في 17‏/6‏/2022 at 22:13, عمر ضاحى said:

اولا اسمحو لى ان اضيف طلب تعديل بسيط 

عجبنى الكود صراحتا 

وكنت حابب انى احسن على الكود

عن طريق اولا ان يتم استبدال كلمة "الملفات" بمعرف السجل ID

عمل كود لمعرفة اذا كان هناك مجلد يحمل نفس المعرف ام لا 

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

علشان ممكن يتم مثلا عمل خطابات معينه لموظفين 

فيقوم الكود بارسال بيانات الموظف الى ملف الورد وحفظه فى مجلد يحمل رقم الموظف 

بحيث اذا كان هناك اكثر من طلب خطاب للموظف يكونو محفوظين فى مجلد واحد يخص الموظف

^_^

 

 

[ابو البشر]

2 ساعات مضت, عمر ضاحى said:

^_^

ابشر ان شاء الله اتحلت 

نجرب نعدل على الكود بحث يعمل مجلدات جديده باسم الموظف (رقم ID)

تفضل هذا الكود يقوم باللازم ... يقوم بانشاء مجلد برقم ID  السجل اذا كان المجلد غير موجود .... ثم يحفظ ملف الووورد الخاص بالسجل داخله ... جرب واخبرنا

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

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

Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير")
If Warning = vbYes Then
Application.FollowHyperlink MWordDocCopyOf
Else
DoCmd.CancelEvent
End If

 

[Eng.Qassim]

في 18‏/6‏/2022 at 20:06, ابو البشر said:

الصق هذا الفانك في النموذج .....

ياسلام عليك اخي ابو البشر ..رائع (وحوصلتك كبيرة )😄

فعلا عالم متخفي ...

اظن العبارة مقتبسة من مسلسل عوالم خفية 😍

[ابو البشر]

6 دقائق مضت, Eng.Qassim said:

ياسلام عليك اخي ابو البشر ..رائع (وحوصلتك كبيرة )😄

فعلا عالم متخفي ...

اظن العبارة مقتبسة من مسلسل عوالم خفية 😍

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

العبارة للعلامة أخي @مبرمج سابق

اشكرك على حسن ظنك بي ...

[Eng.Qassim]

6 دقائق مضت, ابو البشر said:

العبارة للعلامة أخي @مبرمج سابق

نعم هو اعرابي يقضي وقته في شعب الجبال مع غنيماته..

وفي المساء يبهرنا بعلمه