עזרה | סימון למילה ראשונה במסמך

[mzk]

איך ניתן להכניס קוד/סימון לפני המילה הראשונה במסמך - שאין לפניה אנטר - ע"י חיפוש והחלפה.

[ישי ישורון]

@mzk אין מצב של מילה ראשונה שאין לפניה אנטר, אא"כ היא השורה הראשונה במסמך, וא"כ מה הבעיה לקודד אותה, עכ"פ למצוא את כל המילים הראשונות במסמך - הקידוד בחיפוש והחלפה הוא: ^13*>

[pcinfogmach]

@ישי-ישורון כתב בעזרה | סימון למילה ראשונה במסמך:

עכ"פ למצוא את כל המילים הראשונות במסמך - הקידוד בחיפוש והחלפה הוא: ^13*>

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

^13[!^32]{1,} (כדי להגדיר בשלילה חיפוש עד הרווח הראשון בפיסקה)

Spoiler

לעומת זאת הקוד: ^13[!^32]@
לא יעבוד מכיון שהחיפוש בוורד הינו חיפוש עצל וממילא הוא ימצא רק את האות הראשונה ולא את כל המילה הראשונה

או אם אתה רוצה לכלול את הרווח הראשון אזי
^13*^32

[mzk]

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

[pcinfogmach]

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

קודם כל תעשה כך:
תיבת חיפוש: [!^13]@^13
תיבת החלפה: @^&
עם סימון תיבת תווים כלליים כמובן

זה יכניס לך את "@" לפני כל פיסקה בכל המסמכים כולל הפסקה הראשונה

אח"כ תמחק את הקידוד בשאר הפיסקאות כך:
תיבת חיפוש: ^13\@
תיבת החלפה : ^p

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

[pcinfogmach]

@mzk

הנה מאקרו מאת Gpt לא בדקתי אותו. סרפרוף הוא נראה בסדר

Sub AddCodeToDocuments()
    Dim folderPath As String
    Dim codeToAdd As String
    Dim includeSubfolders As VbMsgBoxResult
    Dim file As String
    Dim fDialog As FileDialog
    Dim subfolderSearch As String
    
    ' Select folder
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If fDialog.Show = -1 Then
        folderPath = fDialog.SelectedItems(1)
    Else
        MsgBox "לא נבחרה תיקייה, הפעולה תבוטל.", vbExclamation
        Exit Sub
    End If
    
    ' Get code to add
    codeToAdd = InputBox("הכנס את הקוד שברצונך להוסיף לתחילת המסמך:", "הוספת קוד למסמכים")
    If codeToAdd = "" Then
        MsgBox "לא הוזן קוד, הפעולה תבוטל.", vbExclamation
        Exit Sub
    End If
    
    ' Ask if user wants to include subfolders
    includeSubfolders = MsgBox("האם לכלול תתי תיקיות?", vbYesNo + vbQuestion, "אפשרות תתי תיקיות")
    
    ' Add slash to folder path if not present
    If Right(folderPath, 1) <> "\" Then
        folderPath = folderPath & "\"
    End If
    
    ' Loop through all Word-compatible documents in the folder
    ProcessFilesInFolder folderPath, codeToAdd, includeSubfolders
    
    MsgBox "הפעולה הושלמה בהצלחה!", vbInformation
End Sub

Sub ProcessFilesInFolder(folderPath As String, codeToAdd As String, includeSubfolders As VbMsgBoxResult)
    Dim fileTypes As Variant
    Dim file As String
    Dim i As Integer
    
    ' Define file extensions to process (Word-compatible)
    fileTypes = Array("*.docx", "*.doc", "*.rtf", "*.txt", "*.html", "*.htm", "*.mht", "*.mhtml", "*.xml", "*.odt", "*.wps")
    
    ' Loop through each file type
    For i = LBound(fileTypes) To UBound(fileTypes)
        file = Dir(folderPath & fileTypes(i), vbNormal)
        Do While file <> ""
            ProcessDocument folderPath & file, codeToAdd
            file = Dir
        Loop
    Next i
    
    ' Include subfolders if user selected 'Yes'
    If includeSubfolders = vbYes Then
        Dim subfolder As Collection
        Set subfolder = GetSubfolders(folderPath)
        
        Dim subfile As Variant
        For Each subfile In subfolder
            For i = LBound(fileTypes) To UBound(fileTypes)
                file = Dir(subfile & "\" & fileTypes(i), vbNormal)
                Do While file <> ""
                    ProcessDocument subfile & "\" & file, codeToAdd
                    file = Dir
                Loop
            Next i
        Next subfile
    End If
End Sub

Sub ProcessDocument(docPath As String, codeToAdd As String)
    Dim doc As Document
    
    ' Open the document
    On Error Resume Next
    Set doc = Documents.Open(docPath)
    If Err.Number <> 0 Then
        Err.Clear
        Exit Sub
    End If
    On Error GoTo 0
    
    ' Add code at the beginning
    doc.Content.InsertBefore codeToAdd
    
    ' Save and close the document
    doc.Save
    doc.Close
End Sub

Function GetSubfolders(folder As String) As Collection
    Dim fso As Object
    Dim folderObj As Object
    Dim subfolders As Object
    Dim subfolder As Object
    Dim result As New Collection
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folderObj = fso.GetFolder(folder)
    Set subfolders = folderObj.Subfolders
    
    For Each subfolder In subfolders
        result.Add subfolder.Path
    Next subfolder
    
    Set GetSubfolders = result
End Function

[mzk]

@pcinfogmach יישר כח גדול.
עדיף לי להשתמש בשימושי לוורד, כי יש לי עוד כמה וכמה החלפות.
עזרת לי מאד.