עזרה בחיפוש ובחירה בוורד
-
יש לי קובץ של מאות עמודים של קונטרס,
זה מחולק בצורה של הערות קטנות של כל אברך.
עכשיו לפני הדפסה אני מעוניין להדפיס לכל אברך את מה שהוא כתב, לצורך הגהה.
מישהו אולי יוכל לתת לי רעיון איך אני יכול למיין את הערות ולא שאני יצטרך להעתיק אחד אחד?מצורף קובץ לדוג' מתוך הקונטרס.
______פרק ראשון ערוך.docx -
יש לי קובץ של מאות עמודים של קונטרס,
זה מחולק בצורה של הערות קטנות של כל אברך.
עכשיו לפני הדפסה אני מעוניין להדפיס לכל אברך את מה שהוא כתב, לצורך הגהה.
מישהו אולי יוכל לתת לי רעיון איך אני יכול למיין את הערות ולא שאני יצטרך להעתיק אחד אחד?מצורף קובץ לדוג' מתוך הקונטרס.
______פרק ראשון ערוך.docx@א.-יעקבוביץ-0 אם השמות של כל אחד היה לפני כל הערה היה אפשר בקלות, דרך החלף להחיל כותרת על כל שם, ואחר כך אפשר למיין בלחיצה אחת לפי כותרות, אבל היות שהשמות כתובות אחרי כל הערה, צריך פשוט למצוא דרך להעביר את זה לפני, אולי ע"י איזה מאקרו, אבל אין לי עכשיו הזמן לזה.
-
@א.-יעקבוביץ-0 אם השמות של כל אחד היה לפני כל הערה היה אפשר בקלות, דרך החלף להחיל כותרת על כל שם, ואחר כך אפשר למיין בלחיצה אחת לפי כותרות, אבל היות שהשמות כתובות אחרי כל הערה, צריך פשוט למצוא דרך להעביר את זה לפני, אולי ע"י איזה מאקרו, אבל אין לי עכשיו הזמן לזה.
@מניין אבל השם וההערה של אחרי זה הם שתי מקטעים לא קשורים.
הכותרת מחברת את המקטע שאחריה? -
@מניין אבל השם וההערה של אחרי זה הם שתי מקטעים לא קשורים.
הכותרת מחברת את המקטע שאחריה?@א.-יעקבוביץ-0 כתב בעזרה בחיפוש ובחירה בוורד:
@מניין אבל השם וההערה של אחרי זה הם שתי מקטעים לא קשורים.
הכותרת מחברת את המקטע שאחריה?כן
-
-
יש לי קובץ של מאות עמודים של קונטרס,
זה מחולק בצורה של הערות קטנות של כל אברך.
עכשיו לפני הדפסה אני מעוניין להדפיס לכל אברך את מה שהוא כתב, לצורך הגהה.
מישהו אולי יוכל לתת לי רעיון איך אני יכול למיין את הערות ולא שאני יצטרך להעתיק אחד אחד?מצורף קובץ לדוג' מתוך הקונטרס.
______פרק ראשון ערוך.docx@א.-יעקבוביץ-0 זה נשמע משהו שמתאים ל''עבודת נמלים בוורד''
https://sites.google.com/view/chachamim/בית?authuser=0
אם אתה מעוניין אתה מזומן לפנות למייל שלי בפרופיל -
@א.-יעקבוביץ-0 השקעתי בך...
רק הערה קטנה:
הקובץ הזה לא מסודר בעליל הוא מלא במעברי שורה ומקטע שלא במקומםהסבר קצר על הקוד:
מכניסים את השם של הרב (כולל המילה "הרב")
מחפש את השם של הרב כולל מעבר שורה לפני ואחרי השם (בכדי להימנע משמות שמופיעים בתוך הטקסט)
מרחיב את הטווח שנמצא אחורה, עד המילה "הרב" שיש מעבר שורה לפניה
מעתיק את הטווח לקובץ חדש
וחוזר חלילה...באגים:
לא מסתדר עם "מורנו ראש הכולל" (אולי תחליף ל"הרב ראש הכולל")
לא מסתדר עם ההערה הראשונה
מקוה שאין עוד...Sub מצא_את_הערות_הרב() Dim rng As Range Dim rng2 As Range Dim findRng As Range Dim findText() As String Dim ravName As String Dim newDoc As Document Dim i As Integer ravName = InputBox("הכנס את שם הרב") ravName = Chr(13) & ravName & Chr(13) Set rng = ActiveDocument.Range Set rng2 = ActiveDocument.Range rng.Start = Search(rng.Duplicate, Chr(13) & "הרב", True).Start rng2.End = Search(rng2.Duplicate, Chr(13) & "הרב", True).Start Set findRng = rng.Duplicate Do Until findRng Is Nothing i = i + 1 Set findRng = Search(rng.Duplicate, ravName, True) If findRng Is Nothing Then Exit Do rng2.End = findRng.Start With findRng If Not Search(rng2.Duplicate, Chr(13) & "הרב", False) Is Nothing Then .Start = Search(rng2.Duplicate, Chr(13) & "הרב", False).End End If .MoveStartUntil Chr(13) .MoveStart wdCharacter, 1 End With ReDim Preserve findText(i) findText(i) = findRng.text rng.Start = findRng.End Loop Set newDoc = Documents.Add If i = 1 Then Exit Sub For i = LBound(findText) To UBound(findText) With newDoc.Range .InsertAfter Chr(13) & findText(i) .Collapse wdCollapseEnd End With Next i End Sub Function Search(rng As Range, text As String, forwardOption As Boolean) As Range With rng.Find .ClearFormatting .text = text .Forward = forwardOption .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False If .Execute Then Set Search = rng.Duplicate End If End With End Function
-
@א.-יעקבוביץ-0 אם השמות של כל אחד היה לפני כל הערה היה אפשר בקלות, דרך החלף להחיל כותרת על כל שם, ואחר כך אפשר למיין בלחיצה אחת לפי כותרות, אבל היות שהשמות כתובות אחרי כל הערה, צריך פשוט למצוא דרך להעביר את זה לפני, אולי ע"י איזה מאקרו, אבל אין לי עכשיו הזמן לזה.
@מניין כתב בעזרה בחיפוש ובחירה בוורד:
אבל היות שהשמות כתובות אחרי כל הערה, צריך פשוט למצוא דרך להעביר את זה לפני
אפשר להעביר לפני על ידי חיפוש והחלפה בשני שלבים
שלב א
אם נדרש משהו יותר מסויים אפשר לשלב את המילה הרב עם תווים כלליים וכיו"ב.שלב ב
-
@א.-יעקבוביץ-0 השקעתי בך...
רק הערה קטנה:
הקובץ הזה לא מסודר בעליל הוא מלא במעברי שורה ומקטע שלא במקומםהסבר קצר על הקוד:
מכניסים את השם של הרב (כולל המילה "הרב")
מחפש את השם של הרב כולל מעבר שורה לפני ואחרי השם (בכדי להימנע משמות שמופיעים בתוך הטקסט)
מרחיב את הטווח שנמצא אחורה, עד המילה "הרב" שיש מעבר שורה לפניה
מעתיק את הטווח לקובץ חדש
וחוזר חלילה...באגים:
לא מסתדר עם "מורנו ראש הכולל" (אולי תחליף ל"הרב ראש הכולל")
לא מסתדר עם ההערה הראשונה
מקוה שאין עוד...Sub מצא_את_הערות_הרב() Dim rng As Range Dim rng2 As Range Dim findRng As Range Dim findText() As String Dim ravName As String Dim newDoc As Document Dim i As Integer ravName = InputBox("הכנס את שם הרב") ravName = Chr(13) & ravName & Chr(13) Set rng = ActiveDocument.Range Set rng2 = ActiveDocument.Range rng.Start = Search(rng.Duplicate, Chr(13) & "הרב", True).Start rng2.End = Search(rng2.Duplicate, Chr(13) & "הרב", True).Start Set findRng = rng.Duplicate Do Until findRng Is Nothing i = i + 1 Set findRng = Search(rng.Duplicate, ravName, True) If findRng Is Nothing Then Exit Do rng2.End = findRng.Start With findRng If Not Search(rng2.Duplicate, Chr(13) & "הרב", False) Is Nothing Then .Start = Search(rng2.Duplicate, Chr(13) & "הרב", False).End End If .MoveStartUntil Chr(13) .MoveStart wdCharacter, 1 End With ReDim Preserve findText(i) findText(i) = findRng.text rng.Start = findRng.End Loop Set newDoc = Documents.Add If i = 1 Then Exit Sub For i = LBound(findText) To UBound(findText) With newDoc.Range .InsertAfter Chr(13) & findText(i) .Collapse wdCollapseEnd End With Next i End Sub Function Search(rng As Range, text As String, forwardOption As Boolean) As Range With rng.Find .ClearFormatting .text = text .Forward = forwardOption .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False If .Execute Then Set Search = rng.Duplicate End If End With End Function
@שלמה11 כתב בעזרה בחיפוש ובחירה בוורד:
השקעתי בך...
יישר כח תזכה למצוות, שיעמוד לך לזכות.
צאט gpt נתן לי הרגע פתרון מצוין בלי שום באגים.מייצר לי בלחיצת כפתור קובץ לכל אחד עם כל מה שכתב:
Sub ExportSectionsByAuthor() Dim para As Paragraph Dim paraText As String Dim currentAuthor As Variant Dim authors As Variant Dim docDict As Object Dim newDoc As Document Dim pendingText As String Dim i As Long ' רשימת כל שמות הכותבים במסמך authors = Array( _ "הרב משה כהן", _ "הרב ישראל הירשמן", _ "הרב ברוך גודלבסקי", _ "הרב שלום מרדכי ובר", _ "הרב אהרן יעקובוביץ", _ "הרב דוד ישראלי", _ "הרב שמעון לוי", _ "הרב צבי וינגורט", _ "הרב אברהם ישעיהו לוין", _ "הרב נחמן פישר", _ "מורנו ראש הכולל שליט""א" _ ) ' יצירת מילון לאגירת טקסטים לכל כותב Set docDict = CreateObject("Scripting.Dictionary") For i = 0 To UBound(authors) docDict.Add authors(i), "" Next i pendingText = "" ' מעבר על כל פסקה במסמך For Each para In ActiveDocument.Paragraphs paraText = para.Range.Text Dim foundAuthor As String foundAuthor = "" ' בדיקה האם הפסקה מכילה את שם אחד הכותבים For i = 0 To UBound(authors) If InStr(paraText, authors(i)) > 0 Then foundAuthor = authors(i) Exit For End If Next i If foundAuthor <> "" Then ' הפסקה היא של חתימה – יש לשייך את הטקסט שנצבר למי שהופיע בה docDict(foundAuthor) = docDict(foundAuthor) & pendingText & paraText pendingText = "" ' אפס את הצבירה Else pendingText = pendingText & paraText End If Next para ' שמירה של כל המסמכים For Each currentAuthor In docDict.Keys If Trim(docDict(currentAuthor)) <> "" Then Set newDoc = Documents.Add newDoc.Range.Text = docDict(currentAuthor) ' ניקוי שם קובץ Dim safeName As String safeName = currentAuthor safeName = Replace(safeName, ":", "-") safeName = Replace(safeName, "\", "-") safeName = Replace(safeName, "/", "-") safeName = Replace(safeName, "*", "-") safeName = Replace(safeName, "?", "") safeName = Replace(safeName, Chr(34), "") safeName = Replace(safeName, "<", "") safeName = Replace(safeName, ">", "") safeName = Replace(safeName, "|", "") newDoc.SaveAs2 FileName:=safeName & ".docx" newDoc.Close End If Next MsgBox "המסמכים נוצרו בהצלחה!" End Sub
-
-
-
@א.-יעקבוביץ-0 השקעתי בך...
רק הערה קטנה:
הקובץ הזה לא מסודר בעליל הוא מלא במעברי שורה ומקטע שלא במקומםהסבר קצר על הקוד:
מכניסים את השם של הרב (כולל המילה "הרב")
מחפש את השם של הרב כולל מעבר שורה לפני ואחרי השם (בכדי להימנע משמות שמופיעים בתוך הטקסט)
מרחיב את הטווח שנמצא אחורה, עד המילה "הרב" שיש מעבר שורה לפניה
מעתיק את הטווח לקובץ חדש
וחוזר חלילה...באגים:
לא מסתדר עם "מורנו ראש הכולל" (אולי תחליף ל"הרב ראש הכולל")
לא מסתדר עם ההערה הראשונה
מקוה שאין עוד...Sub מצא_את_הערות_הרב() Dim rng As Range Dim rng2 As Range Dim findRng As Range Dim findText() As String Dim ravName As String Dim newDoc As Document Dim i As Integer ravName = InputBox("הכנס את שם הרב") ravName = Chr(13) & ravName & Chr(13) Set rng = ActiveDocument.Range Set rng2 = ActiveDocument.Range rng.Start = Search(rng.Duplicate, Chr(13) & "הרב", True).Start rng2.End = Search(rng2.Duplicate, Chr(13) & "הרב", True).Start Set findRng = rng.Duplicate Do Until findRng Is Nothing i = i + 1 Set findRng = Search(rng.Duplicate, ravName, True) If findRng Is Nothing Then Exit Do rng2.End = findRng.Start With findRng If Not Search(rng2.Duplicate, Chr(13) & "הרב", False) Is Nothing Then .Start = Search(rng2.Duplicate, Chr(13) & "הרב", False).End End If .MoveStartUntil Chr(13) .MoveStart wdCharacter, 1 End With ReDim Preserve findText(i) findText(i) = findRng.text rng.Start = findRng.End Loop Set newDoc = Documents.Add If i = 1 Then Exit Sub For i = LBound(findText) To UBound(findText) With newDoc.Range .InsertAfter Chr(13) & findText(i) .Collapse wdCollapseEnd End With Next i End Sub Function Search(rng As Range, text As String, forwardOption As Boolean) As Range With rng.Find .ClearFormatting .text = text .Forward = forwardOption .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False If .Execute Then Set Search = rng.Duplicate End If End With End Function
@שלמה11 כתב בעזרה בחיפוש ובחירה בוורד:
רק הערה קטנה:
הקובץ הזה לא מסודר בעליל הוא מלא במעברי שורה ומקטע שלא במקומםהקובץ הזה הוא רק ניסיוני.
כל המעברי שורה זה בגלל שהקובץ היה מוכן להדפסה על גופן מסוים שמסתבר שאין לך אותו, ובעקבות כך הכל היה נראה לך לא במקום