أكاديمية الصقر للتدريب
موضوع بعنوان :سؤال وارد بخصوص دمج المراسلات بين الاكسل والوورد
الكاتب :محمود الشريف


السادة // أعضاء المنتدى             الكرام
السلام عليكم ورحمه الله وبركاته ،،،

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

من قبل 
الأستاذ //  abdulwahed catran

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

أما فيما يختص بسؤاله عن جعل كل صفحة من ملف الوورد بملف مستقل 
بعد أن تتم عملية الدمج كاملة سيتم إنشاء ملف وورد جديد 
ضع داخل الملف الوورد الذى تم إنشاؤه الكود التالي سيقوم تلقائيا بفصل صفحة فى ملف جديد 
ملحوظة (( قد تجد إهتزاز لشاشة الوورد )) أثناء تشغيل الكود لا تقلق 
( هو فقط يقوم بعملية إنشاء ونسخ متكررة حسب عدد صفحات ملف الوورد الذى تم إنشاؤه بعد الدمج )
الكود مطابق لملف الشرح بالموضوع السابق الإشارة إليه أعلاه
فقط قم بتغيير المسميات العربية التى بين قوسين تنصيص
ضع الكود التالى داخل موديول وقم بربطه بزر

Public Sub Trans_to_copy()
Dim Rng As Range
Dim Mu_a$, Pth$
Dim ii%, i%, Nx%, Np%
Dim Num%, A%, B%, x%
'****************
On_1:

'يمكنك استبدال كلمة الكشف التى تظهر كأسم للملف بأى لكمة أخرى
'يتم تسمية الملف على سبيل المثال كالتالي
'الكشف - 1
'ورقم واحد نظرا لإتباطها برقم كود الموظف حسب ملف الشرح

Mu_a = "الكشف"
'****************
Np = 0
On Error Resume Next
Num = ActiveDocument.ActiveWindow.ActivePane.Pages.Count
A = InputBox("إدخل عدد الصفحات لكل موضوع ويفضل ترك الرقم الافتراضي كما هو", , 1)
B = InputBox("إدخل عدد المواضيع ويفضل ترك الرقم الافتراضى كما هو", , 1)
x = A
For ii = 1 To Num Step A
Np = Np + 1
i = ii: Nx = ii + x
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i
  Set Rng = Selection.Range
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=Nx
    Rng.End = Selection.Bookmarks("\Page").Range.End
 Rng.Select
    Selection.Copy
    Application.Documents.Add
    Selection.Paste
   Pth = ThisDocument.Path & "\"
  ActiveDocument.SaveAs Pth & Mu_a & " - " & Np & ".docx"
ActiveDocument.Close
Next
On Error GoTo 0
ActiveDocument.Range(1, 1).Select
'يمكنك تغيير نص الرسالة التى تظهر حتى تتطابق مع الموضوع الخاص بك
MsgBox "تم تقسيم ملف كشوف المرتبات كل كشف بملف وورد مستقل بنجاح", vbInformation, ""
Set Rng = Nothing
End Sub