اذهب الي المحتوي
أوفيسنا

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

حامل المسك

بواسطه حامل المسك
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

حامل المسك

حامل المسك

قام بنشر
قام بنشر

السلام عليكم ..

الأساتذة الكرام،،

سلمكم الله ورعاكم ووفقكم،،

لدي هذا الكود وهو يقوم بتصدير الحقول إلى الوورد 

OpenClsword (CurrentProject.Path & "\asd.docx")

   Objwrd.ActiveDocument.Bookmarks("A1").Select
    Objwrd.Selection.InsertAfter Jhhh
     Objwrd.ActiveDocument.Bookmarks("A1").Select
     Objwrd.Selection.InsertAfter Subsader
     Objwrd.ActiveDocument.Bookmarks("A3").Select
    Objwrd.Selection.InsertAfter Datesader
    Objwrd.ActiveDocument.Bookmarks("A4").Select
    Objwrd.Selection.InsertAfter annexes
    Objwrd.ActiveDocument.Bookmarks("A3").Select
    Objwrd.Selection.InsertAfter sndOfficialn

أود التعديل عليه بحيث يفتح ملف الوورد asd على النحو الآتي:

1) بأخذ نسخة منه (حفظ باسم) ويغلقه

2) يسمى الملف الجديد بتاريخ اليوم 

3) يفتحه ويتم ملء البيانات وفق الكود السابق

4) يعرضه للمستخدم

مع العلم أنه ربما يكون هناك مجموعة ملفات وورد مفتوحة فأود ألا يؤثر عليها ولا يغلقها لأن وجدت كود سابق يغلق كافة الملفات..

مع جزيل الشكر وعظيم الامتنان،،

رابط هذا التعليق
شارك
ابو البشر

ابو البشر

قام بنشر
قام بنشر

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

جرب كده ...... 

OpenClsword (CurrentProject.Path & "\asd.docx")

   Objwrd.ActiveDocument.Bookmarks("A1").Select
    Objwrd.Selection.InsertAfter Jhhh
     Objwrd.ActiveDocument.Bookmarks("A1").Select
     Objwrd.Selection.InsertAfter Subsader
     Objwrd.ActiveDocument.Bookmarks("A3").Select
    Objwrd.Selection.InsertAfter Datesader
    Objwrd.ActiveDocument.Bookmarks("A4").Select
    Objwrd.Selection.InsertAfter annexes
    Objwrd.ActiveDocument.Bookmarks("A3").Select
    Objwrd.Selection.InsertAfter sndOfficialn
Objwrd.SaveAs2 CurrentProject.Path & "\" & Date & ".docx"
Objwrd.Close False

 

  • Like 1
رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر

ربنا يكرمك أباب البشر،،

فتح ملف الوورد ووضع البيانات لكن لم يحفظه حفظ باسم بل ترك الملف مفتوحا.. وكأن الكود أدناه غير موجود..  

Objwrd.SaveAs2 CurrentProject.Path & "\" & Date & ".docx"
Objwrd.Close False

 

رابط هذا التعليق
شارك
ابو البشر

ابو البشر

قام بنشر
قام بنشر
13 ساعات مضت, حامل المسك said:

ربنا يكرمك أباب البشر،،

فتح ملف الوورد ووضع البيانات لكن لم يحفظه حفظ باسم بل ترك الملف مفتوحا.. وكأن الكود أدناه غير موجود..  

Objwrd.SaveAs2 CurrentProject.Path & "\" & Date & ".docx"
Objwrd.Close False

 

طيب ممكن مثال مصغر مع ملف الوورد ... للتعديل عليه ...

رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر

سلمت أيها الكريم..

مرفق الملف..

إذا تكرمت المطلوب نقل البيانات إلى ملف الوورد ثم حفظه باسم (بتاريخ اليوم) وتظهر رسالة تفيد بإتمام الحفظ وهل تريد فتح الملف أم لا..

تحفظ جميع النسخة (حفظ باسم) في مجلد الملفات

تصدير البيانات للوورد.rar

رابط هذا التعليق
شارك
ابو البشر

ابو البشر

قام بنشر
قام بنشر

استخدم هذا الكود ..... 

Dim LWordDocOriginal      As String
Dim LWordDocCopyOf        As String
Dim Warning               As String
    LWordDocOriginal = CurrentProject.Path & "\asd.docx"
    LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx"
        FileCopy LWordDocOriginal, LWordDocCopyOf

Dim LWordDoc As Object
Set LWordDoc = CreateObject("Word.Application")

    LWordDoc.Documents.Open CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx"
    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(Date, "dd-mm-yyyy") & ".docx").Save
LWordDoc.Quit
    Set LWordDoc = Nothing

Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير")
If Warning = vbYes Then
Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx"
Else
DoCmd.CancelEvent
End If

 

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر

ما شاء الله تبارك الله ...

أبدعت ثم أبدعت ثم أبدعت..

سلمت أناملك ورفع الله قدرك وفرج همك وغمك ورضي عنك وأرضاك وكل من قرأ وشارك واستفاد وأفاد..

  • Thanks 1
رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر

في حال تعديل الكود على هذا الأمر هل يتضرر شيء معين.. بتعديل (( (Now(), "dd_mm_yyyy_hh_mm_AM/PM") )) 

Dim LWordDocOriginal      As String
Dim LWordDocCopyOf        As String
Dim Warning               As String
    LWordDocOriginal = CurrentProject.Path & "\asd.docx"
    LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
        FileCopy LWordDocOriginal, LWordDocCopyOf

Dim LWordDoc As Object
Set LWordDoc = CreateObject("Word.Application")

    LWordDoc.Documents.Open CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
    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

Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير")
If Warning = vbYes Then
Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
Else
DoCmd.CancelEvent
End If

 

رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر (معدل)

الشرطة ليست في اسم الملف إنما لكتابة Am أو pm

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

الأولى: عندما يكون الوقت على سبيل المثال في نهاية الدقيقة مثلا 23 وينتقل إلى الدقيقة 24 فإن اسم الملف يتغير  هذا 

1 ساعه مضت, حامل المسك said: 
 LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"

عن هذا

1 ساعه مضت, حامل المسك said: 
Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير")
If Warning = vbYes Then
Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
Else

ويعطي رسالة خطأ فهل بإمكان التعديل بحيث يكون الثابت لاسم الملف هو الاسم الذي في البداية

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

 

مع جزيل الشكر وعظيم الامتنان،،

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

عمر ضاحى

قام بنشر
قام بنشر
4 ساعات مضت, ابو البشر said:

استخدم هذا الكود ..... 

Dim LWordDocOriginal      As String
Dim LWordDocCopyOf        As String
Dim Warning               As String
    LWordDocOriginal = CurrentProject.Path & "\asd.docx"
    LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx"
        FileCopy LWordDocOriginal, LWordDocCopyOf

Dim LWordDoc As Object
Set LWordDoc = CreateObject("Word.Application")

    LWordDoc.Documents.Open CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx"
    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(Date, "dd-mm-yyyy") & ".docx").Save
LWordDoc.Quit
    Set LWordDoc = Nothing

Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير")
If Warning = vbYes Then
Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx"
Else
DoCmd.CancelEvent
End If

 

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

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

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

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

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

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

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

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

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

^_^

 

رابط هذا التعليق
شارك
ابو البشر

ابو البشر

قام بنشر
قام بنشر
منذ ساعه, حامل المسك said:

الشرطة ليست في اسم الملف إنما لكتابة Am أو pm

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

الأولى: عندما يكون الوقت على سبيل المثال في نهاية الدقيقة مثلا 23 وينتقل إلى الدقيقة 24 فإن اسم الملف يتغير  هذا 

عن هذا

ويعطي رسالة خطأ فهل بإمكان التعديل بحيث يكون الثابت لاسم الملف هو الاسم الذي في البداية

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

 

مع جزيل الشكر وعظيم الامتنان،،

استبدل الكود بهذا ..... 

Dim MWordDocCopyOf        As String
Dim LWordDocOriginal      As String
Dim LWordDocCopyOf        As String
Dim Warning               As String
    LWordDocOriginal = CurrentProject.Path & "\asd.docx"
    LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
        FileCopy LWordDocOriginal, LWordDocCopyOf
        MWordDocCopyOf = LWordDocCopyOf
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(Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx").Save
    LWordDoc.Quit
    Set LWordDoc = Nothing

Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير")
If Warning = vbYes Then
Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
Else
DoCmd.CancelEvent
End If

 

25 دقائق مضت, عمر ضاحى said:

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

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

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

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

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

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

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

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

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

^_^

 

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

وابشر استاذ @عمر ضاحى

  • Like 2
رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر
50 دقائق مضت, ابو البشر said:

استبدل الكود بهذا .....

ممتاز جدا عمل الشكل الرائع،،

تبقى مسألة التوقيت بحيث إذا كان الأمر في نهاية دقيقة معينة فإنه يحدث تعارض في التوقيت

1 ساعه مضت, حامل المسك said:

الأولى: عندما يكون الوقت على سبيل المثال في نهاية الدقيقة مثلا 23 وينتقل إلى الدقيقة 24 فإن اسم الملف يتغير  هذا 

 

رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر
9 ساعات مضت, ابو البشر said:

هل تظهر المشكلة في لحظة فتح الملف ام في التصدير

نعم ظهرت المشكلة مرتين

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

image.png.2afb037c0662c47bc2b5a75e764fdd93.png

ومرة على الكود الأخير  

If Warning = vbYes Then
Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
Else
DoCmd.CancelEvent

وقد لاحظت هذه المشكلة لأن الوقت كان الساعة 9.17 وأثناء العملية انتقل الوقت إلى الساعة 9.18 فحدث هذا لإشكال

 

وكذلك عندما جاءت الرسالة 

image.png.ad09d9d916a01fe8c4afe7043ef02d6a.png

 

وضغت نعم وفتح الملف ولم أغلقه

وطلبت التصدير مرة أخرى جاءت هذه الرسالة

image.png.2c7e54d5b854cbb696b3a3b45c915ff0.png

 

وإذا تكرمت نريد أن تأتي رسالة تفيد بأن الملف مفتوح ويجب إغلاقه

 

رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر

لعل المشكلة تكمن في تعريف اسم الملف حيث اعتمدنا فيه الدقائق والدقائق سريعة التغير بخلاف الساعة..

فهل بالإمكان تعريف اسم الملف في الأول بحيث يكون هو الثابت لما بعده.. لأن ما بعده يأخذ اسما جديدا وربما تكون الدقيقة قد تغيرت..

14 ساعات مضت, ابو البشر said: 
Dim MWordDocCopyOf        As String
Dim LWordDocOriginal      As String
Dim LWordDocCopyOf        As String
Dim Warning               As String
    LWordDocOriginal = CurrentProject.Path & "\asd.docx"
    LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"

 

رابط هذا التعليق
شارك
ابو البشر

ابو البشر

قام بنشر
قام بنشر
منذ ساعه, حامل المسك said:

لعل المشكلة تكمن في تعريف اسم الملف حيث اعتمدنا فيه الدقائق والدقائق سريعة التغير بخلاف الساعة..

فهل بالإمكان تعريف اسم الملف في الأول بحيث يكون هو الثابت لما بعده.. لأن ما بعده يأخذ اسما جديدا وربما تكون الدقيقة قد تغيرت..

 

تقضل جرب  

Dim MWordDocCopyOf        As String
Dim NWordDocCopyOf        As String
Dim LWordDocOriginal      As String
Dim LWordDocCopyOf        As String
Dim Warning               As String
    LWordDocOriginal = CurrentProject.Path & "\asd.docx"
    LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx"
        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
    LWordDoc.Quit
    Set LWordDoc = Nothing

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

 

  • Like 3
رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر

ممتاز جدا ورائع الله يعطيك العافية.. ومعذرة كلفت عليك بقي آخر شيء..

وهو أن الملف إذا كان مفتوح وعملت تصدير مرة أخرى في نفس الدقيقة تأتي هذه الرسالة

image.png.2f6352c01faaa065d41bcca49c858b85.png

فنحتاج أن تأتي رسالة بأن الملف مفتوح هل تريد إغلاقة وفتحه مرة أخرى .. مثلا..

رابط هذا التعليق
شارك
ابو البشر

ابو البشر

قام بنشر
قام بنشر
1 ساعه مضت, حامل المسك said:

ممتاز جدا ورائع الله يعطيك العافية.. ومعذرة كلفت عليك بقي آخر شيء..

وهو أن الملف إذا كان مفتوح وعملت تصدير مرة أخرى في نفس الدقيقة تأتي هذه الرسالة

image.png.2f6352c01faaa065d41bcca49c858b85.png

فنحتاج أن تأتي رسالة بأن الملف مفتوح هل تريد إغلاقة وفتحه مرة أخرى .. مثلا..

تفضل ...... 

Dim MWordDocCopyOf        As String
Dim NWordDocCopyOf        As String
Dim LWordDocOriginal      As String
Dim LWordDocCopyOf        As String
Dim Warning               As String
    LWordDocOriginal = CurrentProject.Path & "\asd.docx"
    LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & 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

 

  • Like 2
رابط هذا التعليق
شارك
ابو البشر

ابو البشر

قام بنشر
قام بنشر

اسف اخي الكريم نسيت الفانك 

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

Public Function IsFileLocked(PathName As String) As Boolean
On Error GoTo ErrHandler
  Dim i As Integer
  If Len(Dir$(PathName)) Then
    i = FreeFile()
    Open PathName For Random Access Read Write Lock Read Write As #i
    Lock i
    Unlock i
    Close i
  Else
    Err.Raise 53
  End If
ExitProc:
  On Error GoTo 0
  Exit Function

ErrHandler:
  Select Case Err.Number
    Case 70
      IsFileLocked = True
    Case Else
  
    End Select
  Resume ExitProc
  Resume
End Function

 

  • Like 4
  • Thanks 1
رابط هذا التعليق
شارك
حامل المسك

حامل المسك

قام بنشر
  • الكاتب
قام بنشر

يا سلام علكيم .. يا رائع.. 

كتب الله أجرك ورضي عنك وأرضاك ووفقك لكل خير وبارك لك في أهلك ومالك وولدك..

تماااام

ولك صادق الدعوات وأجر ما يقدم من عمل خيري بهذا البرنامج الذي يمتد أثره بإذن الله زمنا طويلا..

  • Like 2
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept