تقسيم مستند وورد

تقسيم مستند وورد

Word Split

Code VBA To Split Word Document

نجد أحيانا أمامنا مستند وورد ذا حجم كبير مقسم داخليا إلى عدة أقسام ، ونرغب فى فصل هذه الأقسام عن بعضها
اى من مستند يحتوى على مئات الصفحات الى عدة مستندات كل منها يحتوى على بضع صفحات

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

إذا كنت تفضل أسلوب النسخ واللصق ، فيمكنك على الأرجح أن تسمح لـ Word بالقيام بالمهمة نيابة عنك.
فيمكنك إضافة الماكرو إلى "شريط أدوات الوصول السريع" ، بحيث يمكنك استخدامه بشكل متكرر بسهولة.
حيث توفر لنا الـ VBA السرعة والدقة فى إنجاز المطلوب بكل سهولة .


تقوم الشفرة التالية بالتالي :
* تقسيم المستند الى مستندات صغيرة كل منها يحتوى على عدد 3 صفحات .
   يمكنك تغيير هذا الرقم من داخل الشفرة .
* تقوم بالحفظ والتسمية تلقائيا
   التسمية تكون بناء على اسم المستند الأصلي + رقم أول صفحة من المستند الصغير كالتالي :
   بإفتراض ان اسم المستند الأصلي MZM
   يكون الجزء الأول باسم MZM 003
   ويكون الجزء الثاني باسم MZM 006
   والثالث MZM 009 وهكذا ..الخ المستند
* الحفظ يكون بنفس مسار المستند الأصلي لذا يفضل :
   أن تضع الملف الأصلي داخل مجلد منفردا

وإليك الشفرة كاملة
مضمن بها التعليقات التوضيحية

'Permits any person to use this code provided that the source is mentioned
'https://elshriefacademy.blogspot.com

Option Explicit
 
Sub SplitIntoPages()
    Dim docMultiple As Document
    Dim docSingle As Document
    Dim rngPage As Range
    Dim iCurrentPage As Integer
    Dim iPageCount As Integer
    Dim strNewFileName As String
    'Makes the code run faster and reduces screen flicker a bit. 
    Application.ScreenUpdating = False
    'Work on the active document (the one currently containing the Selection)
    Set docMultiple = ActiveDocument 
    'instantiate the range object 
    Set rngPage = docMultiple.Range
    iCurrentPage = 3
     'get the document's page count
    iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
    Do Until iCurrentPage > iPageCount
        If iCurrentPage = iPageCount Then
      'last page (there won't be a next page)
            rngPage.End = ActiveDocument.Range.End 
        Else
             
             'Find the beginning of the next page
             'Must use the Selection object. The Range.Goto method will not work on a page
            Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 3
             'Set the end of the range to the point between the pages
            rngPage.End = Selection.Start
        End If
        'copy the page into the Windows clipboard
        rngPage.Copy 
        Set docSingle = Documents.Add 'create a new document
        docSingle.Range.Paste 'paste the clipboard contents to the new document
         'remove any manual page break to prevent a second blank
        docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
         'build a new sequentially-numbered file name based on the original multi-paged file name and path
        strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
        docSingle.SaveAs strNewFileName 'save the new single-paged document
        iCurrentPage = iCurrentPage + 3 'move to the next page
        docSingle.Close 'close the new document
        rngPage.Collapse wdCollapseEnd 'go to the next page
    Loop 'go to the top of the do loop
    Application.ScreenUpdating = True 'restore the screen updating
     
     'Destroy the objects.
    Set docMultiple = Nothing
    Set docSingle = Nothing
    Set rngPage = Nothing
End Sub