חלוקת מסמך לכמה

בר בי רב

משתמש פעיל
האם יש אופציה אוטומטית לחלק מסמך אחד להרבה חלקים, שווים או לא שווים, בוורד בTXT או בPDF
 

Yisrael

משתמש פעיל
לא הבנתי על איזה קישור אתה מדבר, כתבתי שאפשר לעשות את זה עם קוד ב VB
אם תסביר בדיוק מה הצורך שלך אנסה לעזור
 

Yisrael

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

קוד:
Sub בר_בי_רב
Dim strFolder As String, wdDoc As Document, Rng As Range, Copyng As Range, MyName As String
    application.ScreenUpdating = False
    MyName = ActiveDocument.Name
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    With Selection
        .HomeKey wdStory
        For i = 1 To ActiveDocument.Range.Information(wdActiveEndPageNumber) Step 2 '   / 2
            A = A + 1
            .start = .End
            Set Rng = Selection.Range
            If A >= ActiveDocument.Range.Information(wdActiveEndPageNumber) / 2 Then
                .End = ActiveDocument.Range.End
            Else
                .GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=2, Name:=""
                .start = Rng.start
            End If
            Set Copyng = .Range
            Set wdDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
            wdDoc.Range.text = Copyng.text
            ChangeFileOpenDirectory strFolder
            wdDoc.SaveAs FileName:=Left(MyName, InStr(MyName, ".") - 1) & " Part" & A & ".docx", _
               FileFormat:=wdFormatXMLDocument
            wdDoc.Close
        Next i
        .HomeKey wdStory
    End With
    application.ScreenUpdating = True
End Sub
 

בר בי רב

משתמש פעיל
@israel
תודה רבה!
האם יש סיכוי שהמקרו לא מגיב באופיס 13? או שפשוט לא הפעלתי אותו נכון?
הוא לא פועל
 

Yisrael

משתמש פעיל
לא רואה סיבה כזו.

הוא לא מגיב בכלל? לא נפתח חלון בחירת התיקייה?
 

בר בי רב

משתמש פעיל
1212.png
,
@israel
הנה תמונה
תודה על המסירות
 
נערך לאחרונה ב:

Yisrael

משתמש פעיל
תעבור על הקוד עם F8 (ככה הוא עובר שורה שורה) ותראה אם הוא בכלל נכנס לsub
כמובן כשהסמן נמצא בתוך ה sub
 

Yisrael

משתמש פעיל
מה זאת אומרת על השורות הראשונות, איזה שורות?

תנסה למחוק את השורות האלה:

קוד:
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub

ובשורה הזו
קוד:
ChangeFileOpenDirectory strFolder
במקום strFolder תכתוב את הנתיב של התיקייה שבה אתה רוצה לשמור את הקבצים, עם מרכאות.
 

בר בי רב

משתמש פעיל
מה זאת אומרת על השורות הראשונות, איזה שורות?

תנסה למחוק את השורות האלה:

קוד:
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub

ובשורה הזו
קוד:
ChangeFileOpenDirectory strFolder
במקום strFolder תכתוב את הנתיב של התיקייה שבה אתה רוצה לשמור את הקבצים, עם מרכאות.
אצלי במחשב זה יוצר בנתיב המיקום עותק זהה של הקובץ רק בלי העיצוב. נסיתי פעמיים.
 

אולי מעניין אותך גם...

הפרק היומי

הפרק היומי! כל ערב פרק תהילים חדש. הצטרפו אלינו לקריאת תהילים משותפת!


תהילים פרק קיט א'

א אַשְׁרֵי תְמִימֵי דָרֶךְ הַהֹלְכִים בְּתוֹרַת יְהוָה:ב אַשְׁרֵי נֹצְרֵי עֵדֹתָיו בְּכָל לֵב יִדְרְשׁוּהוּ:ג אַף לֹא פָעֲלוּ עַוְלָה בִּדְרָכָיו הָלָכוּ:ד אַתָּה צִוִּיתָה פִקֻּדֶיךָ לִשְׁמֹר מְאֹד:ה אַחֲלַי יִכֹּנוּ דְרָכָי לִשְׁמֹר חֻקֶּיךָ:ו אָז לֹא אֵבוֹשׁ בְּהַבִּיטִי אֶל כָּל מִצְוֹתֶיךָ:ז אוֹדְךָ בְּיֹשֶׁר לֵבָב בְּלָמְדִי מִשְׁפְּטֵי צִדְקֶךָ:ח אֶת חֻקֶּיךָ אֶשְׁמֹר אַל תַּעַזְבֵנִי עַד מְאֹד:
נקרא  33  פעמים

לוח מודעות

למעלה