פיצול מסמך וורד

[חיה.]

יש לי מסמך וורד ארוך מאד מאד.
אני מעוניינת לשמור כקובץ חדש מספר עמודים מסוים, נניח מעמוד 100 עד עמוד 200. יש אפשרות כזו?!
(בשמירה לPDF אני יכולה להגדיר שמירה של עמודים מסוימים, אך לא מצאתי אפשרות כזו בשמירה רגילה).
תודה גדולה מראש לעונים.

 

[כנגן המנגן]

העתק-הדבק למסמך חדש, לא טוב?

 

[למען דעת]

לבחור מהמקום בו רוצים להתחיל את המסמך החדש - כלפי מעלה עד ההתחלה, ולמחוק.
לבחור מהמקום בו רוצים לסיים את המסמך החדש - עד הסוף, ולמחוק.
לשמור בשם.

 

[חיה.]

זה מה שאני עושה תמיד. אבל:
- העתק הדבק לא שומר לי את הגדרת עמוד, כותרת עליונה ותחתונה וכו'.
- למחוק לפני ואחרי זה המון עבודה כי אני צריכה לגלול את העמוד כמה דקות עד שהוא מוחק את כל העמודים המיותרים.
חשבתי שיש דרך קיצור.

 

[FullTime]

זה מה שאני עושה תמיד. אבל:
- העתק הדבק לא שומר לי את הגדרת עמוד, כותרת עליונה ותחתונה וכו'.
- למחוק לפני ואחרי זה המון עבודה כי אני צריכה לגלול את העמוד כמה דקות עד שהוא מוחק את כל העמודים המיותרים.
חשבתי שיש דרך קיצור.

עושים קונטרול +G (עבור אל) בוחרים בצד ימין 'עמוד' ומכניסים מס' עמוד.
הולכים לתחילת העמוד
קונטרול + שיפט + HOME
והטקסט עד תחילת המסמך נבחר.
זהו, DELETE

אותו דבר לסוף המסמך, רק END במקום HOME

ונשארו רק העמודים הרצויים

 

[moishy]

והנה פתרון "מקרואי" למעוניינים.
אם מעוניינים לשמור את הקבצים החדשים בתיקית המקור, להעתיק את הקוד הבא למודול חדש:

Option Explicit

Sub Test()
    Dim Counter As Long, Pages As Long
    Dim SourceDoc As Document, TargetDoc As Document
    Dim Source As Range, Target As Range
    Dim DocName As String
    Dim i As Integer
    Set SourceDoc = ActiveDocument
    Selection.HomeKey Unit:=wdStory
    Pages = SourceDoc.BuiltInDocumentProperties(wdPropertyPages)
    Counter = 0
    While Counter < Pages
        Counter = Counter + 1
            ' To save the files to the same directory as the ActiveDocument
       DocName = ActiveDocument.Path & "\" & Format(Counter) & " to " & Format(Counter + 99) & GetFileExt(ActiveDocument.Name)
        Set TargetDoc = Documents.Add
        For i = 1 To 100
            Set Target = TargetDoc.Range
            Target.Collapse wdCollapseEnd
            SourceDoc.Activate
            Set Source = SourceDoc.Bookmarks("\Page").Range
            Target.FormattedText = Source.FormattedText
            Source.Delete
        Next i
        TargetDoc.SaveAs FileName:=DocName
        TargetDoc.Close
        Counter = Counter + 99
    Wend
    SourceDoc.Close wdDoNotSaveChanges
End Sub

למעוניינים לבחור יעד לשמירת הקבצים בהפעלת המאקרו, יש להחליף את השורות האלו:

        ' To save the files to the same directory as the ActiveDocument
        DocName = ActiveDocument.Path & "\" & Format(Counter) & " to " & Format(Counter + 1) & GetFileExt(ActiveDocument.Name)

בשורות האלו:

        ' To choose a folder to save the files to
        DocName = BrowseFolder("Select Folder To Save Files") & Format(Counter) & " to " & Format(Counter + 1) & GetFileExt(ActiveDocument.Name)

ובנוסף יש להעתיק את הקוד הבא למודול חדש:

Option Explicit

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function apiFindWindowA Lib "User32" Alias "FindWindowA" (ByVal sClass As String, ByVal xTitle As Long) As Long
Private Declare Function apiSendMessageA Lib "User32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Long) As Long

Private Const WM_USER = 1024

Function fDetectWord() As Long
    Dim lngX As Long, objWord As Object
    lngX = apiFindWindowA("OpusApp", 0)
    If lngX <> 0 Then
        'lngX is the hWnd for Word
        apiSendMessageA lngX, WM_USER + 18, 0, 0
        fDetectWord = lngX
    End If
End Function

Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, BI As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
  
    With BI
        .hOwner = fDetectWord
        .lpszTitle = szDialogTitle
        .ulFlags = &H1 Or &H40 ' &H40 adds the "Create New Folder" button
    End With
    
    dwIList = SHBrowseForFolder(BI)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

 

[חיה.]

moishy תודה רבה מאד!
אבל אני בורה לגמרי במקרו, ויודעת טוב מאד רק את הבסיס של וורד.
יש אפשרות לקבל הסבר לאיפה אני מעתיקה את הקוד וכו' או להפנות אותי למקום בו אקרא ואלמד על כך?
הדבר היחיד שמצאתי בינתיים הינו בכרטיסיית תצוגה לחצן פקודות מאקרו, ושם יש לי אפשרות הקלטת מקרו. זה קשור? מה הלאה?
רוב תודות!

 

[חיה.]

עושים קונטרול +G (עבור אל) בוחרים בצד ימין 'עמוד' ומכניסים מס' עמוד.
הולכים לתחילת העמוד
קונטרול + שיפט + HOME
והטקסט עד תחילת המסמך נבחר.
זהו, DELETE

אותו דבר לסוף המסמך, רק END במקום HOME

ונשארו רק העמודים הרצויים

ממש תודה!! יחסוך לי הרבה מאד עצבים וזמן, וסתם, נחמד לעבוד בצורה 'נקיה' ולא פרימיטיבית.

 

[moishy]

אם עדיין מעניין אותך ראי את זה http://www.prog.co.il/showthread.php?t=85729

 

[שלמה מרלר]

קל וגם פשוט באמצעות אתר https://products.groupdocs.app/splitter/doc
צריך קודם לשמור כקובץ doc