אופיס 365 חלוקת מסמך לכמה

[בר בי רב]

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

 

[Yisrael]

אפשר בוורד ב VBA

 

[בר בי רב]

במידה ואין בזה טירחא אם אפשר קישור יכול לעזור תודה

 

[Yisrael]

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

 

[בר בי רב]

@Yisrael אני צריך לתרגם והגוגל לא מתרגם יותר מכמה עמודים בפעם

 

[Yisrael]

@Yisrael אני צריך לתרגם והגוגל לא מתרגם יותר מכמה עמודים בפעם

מה אתה מנסה לתרגם? מסמך?

 

[בר בי רב]

@Yisrael
מסמך גדול

 

[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]

לא רואה סיבה כזו.

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

 

[בר בי רב]

לצערי הוא לא מגיב כלל, כאילו מקרו ריק!

 

[Yisrael]

אולי תעלה צילום מסך שלו אחרי שהדבקת אצלך...

 

[בר בי רב]

,
@israel
הנה תמונה
תודה על המסירות

 

[Yisrael]

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

 

[בר בי רב]

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

אכן הPC עובר רק על השורות הראשונות פחות או יותר
הוא לא מתייחס לשאר השורות

 

[Yisrael]

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

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

    strFolder = GetFolder
    If strFolder = "" Then Exit Sub

ובשורה הזו

ChangeFileOpenDirectory strFolder

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

 

[בר בי רב]

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

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

    strFolder = GetFolder
    If strFolder = "" Then Exit Sub

ובשורה הזו

ChangeFileOpenDirectory strFolder

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

אצלי במחשב זה יוצר בנתיב המיקום עותק זהה של הקובץ רק בלי העיצוב. נסיתי פעמיים.

 

[Yisrael]

אצלי במחשב זה יוצר בנתיב המיקום עותק זהה של הקובץ רק בלי העיצוב. נסיתי פעמיים.

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

 

[5127109]

פתרון בתשלום כאן:

http://www.extra-word.com/apps/sakumLeWord

 

[בר בי רב]

@5127109
בפועל @israel מאוד עזר לי
אבל ראיתי את האתר מאוד שמחתי
מדהים
נחמד
תצליח