תחומים - פורום חרדי מקצועי

יש בעיה קטנה בקוד ש @פייתוניסט עשה, שהוא לא מטפל באותיות "טו" וב "טז"
אני עשיתי לעצמי תיקון לקוד
אז הנה השיתוף של הקוד לטבת המשתתפים

Function GIMATRIA(x)

    G = ""
    TV = Int(x / 400)
    For i = 1 To TV
        G = G & "ת"
    Next i
    x = x - (TV * 400)
    TV = Int(x / 300)
    For i = 1 To TV
        G = G & "ש"
    Next i
    x = x - (TV * 300)
    TV = Int(x / 200)
    For i = 1 To TV
        G = G & "ר"
    Next i
    x = x - (TV * 200)
    TV = Int(x / 100)
    For i = 1 To TV
        G = G & "ק"
    Next i
    x = x - (TV * 100)
    TV = Int(x / 90)
    For i = 1 To TV
        G = G & "צ"
    Next i
    x = x - (TV * 90)
    TV = Int(x / 80)
    For i = 1 To TV
        G = G & "פ"
    Next i
    x = x - (TV * 80)
    TV = Int(x / 70)
    For i = 1 To TV
        G = G & "ע"
    Next i
    x = x - (TV * 70)
    TV = Int(x / 60)
    For i = 1 To TV
        G = G & "ס"
    Next i
    x = x - (TV * 60)
    TV = Int(x / 50)
    For i = 1 To TV
        G = G & "נ"
    Next i
    x = x - (TV * 50)
    TV = Int(x / 40)
    For i = 1 To TV
        G = G & "מ"
    Next i
    x = x - (TV * 40)
    TV = Int(x / 30)
    For i = 1 To TV
        G = G & "ל"
    Next i
    x = x - (TV * 30)
    TV = Int(x / 20)
    For i = 1 To TV
        G = G & "כ"
    Next i
    If x = 15 Then
        G = G & "טו"
    Else
        If x = 16 Then
            G = G & "טז"
        Else
            
            x = x - (TV * 20)
            TV = Int(x / 10)
            For i = 1 To TV
                G = G & "י"
            Next i
            x = x - (TV * 10)
            TV = Int(x / 9)
            For i = 1 To TV
                G = G & "ט"
            Next i
            x = x - (TV * 9)
            TV = Int(x / 8)
            For i = 1 To TV
                G = G & "ח"
            Next i
            x = x - (TV * 8)
            TV = Int(x / 7)
            For i = 1 To TV
                G = G & "ז"
            Next i
            x = x - (TV * 7)
            TV = Int(x / 6)
            For i = 1 To TV
                G = G & "ו"
            Next i
            x = x - (TV * 6)
            TV = Int(x / 5)
            For i = 1 To TV
                G = G & "ה"
            Next i
            x = x - (TV * 5)
            TV = Int(x / 4)
            For i = 1 To TV
                G = G & "ד"
            Next i
            x = x - (TV * 4)
            TV = Int(x / 3)
            For i = 1 To TV
                G = G & "ג"
            Next i
            x = x - (TV * 3)
            TV = Int(x / 2)
            For i = 1 To TV
                G = G & "ב"
            Next i
            x = x - (TV * 2)
            TV = Int(x / 1)
            For i = 1 To TV
                G = G & "א"
            Next i
            x = x - (TV * 1)
        End If
    End If
    GIMATRIA = G
    
End Function

@yossiz אני עקבתי אחר ההוראות..
אבל עדיין זה לא עובד לי
כוונתי שזה לא עובד בתור פונקציה מקומית באקסל אבל בקוד כשלעצמו עובד לכל דבר
אני אישית הסתדרתי כי צירפתי את הפונקציה לקוד vba אחר וזה עבד לי...

@פייתוניסט ,
לאחר חיטוט בקוד מצאתי שיש באקסל כבר פונקציה בשם GIMATRIA (אני לא יודע אם זה רק אצלי או אצל כולם) בכל אופן לאחר שינוי של השם עובד מעולה
אמנם בvba הקוד עובד
אבל באקסל בתור נוסחה ממש לא..

@פייתוניסט
הפונקציה מחזירה שגיאה

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

בניסיון להעביר את הסמן לסוף המסמך מצאתי את הקוד הזה

Selection.EndKey Unit:=wdStory

מהמדריך הבא

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

    Set objDoc = objWord.Documents.Add
    myPath = "C:\Users\User\Desktop\experience\"
    myFile = Dir(myPath & "*.docx", vbNormal + vbReadOnly + vbHidden)
    While myFile <> ""
        With objDoc.Bookmarks("\StartOfDoc").range
            .InsertFile FileName:=myPath & myFile, _
                ConfirmConversions:=False, Link:=False, Attachment:=False
    Selection.EndKey Unit:=wdStory
        .InsertBreak Type:=2
        End With
        myFile = Dir()
    Wend
    objDoc.Characters(1).Delete
End Sub
 

הסמן אינו עובר לסוף המסמך כלל....

מבדיקה בstackoverflow נראה שזה באג של וורד שאין לו תקנה (מקווה שלא)...

אני רוצה למזג כמה קבצי וורד שמעוצבים באותו הסגנון לקובץ 1.
מצאתי את הקוד הזה

Sub MergeALL()
    Dim objWord As Object
    Dim objDoc As Object
    Dim myPath As String, myFile As String

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True

    Set objDoc = objWord.Documents.Add
    myPath = "C:\Users\User\Desktop\experience\"
    myFile = Dir(myPath & "*.docx", vbNormal + vbReadOnly + vbHidden)
    While myFile <> ""
        With objDoc.Bookmarks("\StartOfDoc").range
            .InsertFile FileName:=myPath & myFile, _
                ConfirmConversions:=False, Link:=False, Attachment:=False
            .InsertBreak Type:=2
        End With
        myFile = Dir()
    Wend
    objDoc.Characters(1).Delete
End Sub

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

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

@yossiz מעיין לדעת
עכשיו אתה פותר לי את השאלה שלי למה רק בסגנון הזה הוורד פתח לי עוד סגנון ולא בסגנונות אחרים .. כי רק הסגנון הזה מתחיל בתחילת פיסקה בסגנון אחד וממשיך בסגנון שני
תודה רבה על המידע

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

אבל המעניין הוא שבסגנונות שיש בחיפוש והחלפה יש 2 סגנונות של אות הלכה כך זה נראה

וכאשר אני מחפש אות הלכה הוא לא מוצא כלום

אבל כאשר אני מחפש אות הלכה תו הוא מוצא

וכאשר אני מסמן בוורד אות הלכה ע"י המקש הוא נכנס להגדרה בחיפוש והחלפה על שם אות הלכה תו

ע"כ ניסיתי בקוד לכתוב אות הלכה תו והכל בא על מקומו בשלום...

למה זה כך ... אולי המתמחים של תחומים ידעו להגיד

עשיתי עיצוב סגנונות על טקסט בקוד vba כך

Selection.Style = ActiveDocument.Styles("אות הלכה")

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

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

@yossiz
אכן מבדיקה שלי אם אני מפעיל בריצה איטית על השורה הזו וממתין כמה שניות הקוד עובר בהצלחה ללא שגיאה
זאת אומרת שאם אני יכתוב פקודה שימתין כמה שניות זה יעבוד מעולה.
עריכה: הוספתי את הפקודה הבאה ועובד מעולה @yossiz @OdedDvir הרבה תודה

Dim tmpStart
tmpStart = Timer
Do
    DoEvents
Loop While (tmpStart + 3) > Timer

@yossiz אמר באיך אני יכול לפצל קובץ וורד גדול לפי מקטעים:

(או להעביר את התוכן ישירות - לא באמצעות לוח ההדבקה)

איך??
גזירה והדבקה?!! גם זה דרך הלוח??!!

@OdedDvir
בהתחלה עבד טוב כעת הוא מחזיר שגיאה
עריכה: השגיאה הזו מעוררת לפי המצב רוח. לפעמים הקוד עובד טוב ולפעמים.....

וכן הוא לא מחזיר לי את שם הקובץ

@OdedDvir תודה ענקית
איך אני מקבל את השם של הקובץ ללא הסיומת?

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

@OdedDvir
תודה אין מילים!!!
התשובה ברורה ולא משאירה מקום לטעות

@yossiz
אני אבאר יותר את הבעיות
יש לי קובץ וורד ששמרתי בו סגנונות שהחלתי על הטקסטים השונים.
כעת יש לי עוד קובץ ששם אני רוצה שיהיה לי את אותם הסגנונות שהיה לי בקובץ הקודם
מחיטוט קצר בגוגל העלתי שאם אני רוצה את הסגנון גם בקבצים הבאים אני צריך לסמן הוסף לגלריית סגנונות תכלס כאשר אני פותח קובץ חדש אני לא מוצא אותם בשום מקום.
בעיה שניה זה כאשר אני מסמן עדכון אוטומטי \ מסמכים חדשים המבוססים וכו' ושומר הוורד אינו שומר את ההגדרה הזו

@mekev
לא קיים

אני מסמן את זה

ועושה אישור
ולאחמ"כ אני פותח שוב והוא חוזר למצב ברירת מחדל

מה יכול להיות הבעיה

עריכה: ביאור השאלה בהרחבה יותר כאן