@menajemmendel יש מישהו שיצר כזה מאקרו להוספת הטיות (פורסם בפורום - לא זוכר מי) - אולי זה ישמש אותך/אתכם - אני משתמש בזה בעת הוספת מילה חדשה למילון - אני מוסיף דרכו - וכך זה מוסיף לי גם את כל ההטיות
מצורף המאקרו שלו:
Sub תיקון_אוטומטי_הוספת_ערך()
Dim mila As String, tikun As String
Dim prefixes As Variant, p As Variant
prefixes = Array("ש", "ו", "ה", "שה", "כשה", "מ", "ד", "ל", "כ", "וב", "ב", "דה")
mila = InputBox("הזן מילה שגויה (הפעולה תוסיף אוטומטית גם תחיליות):", "הוספה חכמה לתיקון אוטומטי")
If mila = "" Then
MsgBox "לא נבחרה מילה, הפעולה בוטלה!", vbMsgBoxRight + vbMsgBoxRtlReading + vbExclamation
Exit Sub
End If
tikun = InputBox("רשום את המילה המתוקנת:", "הוספה חכמה לתיקון אוטומטי", mila)
If tikun = "" Then
Exit Sub
End If
AutoCorrect.Entries.Add Name:=mila, value:=tikun
For Each p In prefixes
AutoCorrect.Entries.Add Name:=(p & mila), value:=(p & tikun)
Next p
MsgBox "הערך '" & mila & "' וכל התחיליות הנלוות נוספו/עודכנו בהצלחה!", vbMsgBoxRight + vbMsgBoxRtlReading + vbInformation
End Sub
Sub תיקון_אוטומטי_הסרת_ערך()
Dim mila_to_remove As String
Dim prefixes As Variant, p As Variant
Dim deletedCount As Long
prefixes = Array("ש", "ו", "ה", "שה", "כשה", "מ", "ד", "ל", "כ", "וב", "ב", "דה")
deletedCount = 0
mila_to_remove = InputBox("הזן את המילה השגויה להסרה (הפעולה תסיר גם את כל התחיליות):", "הסרה מלאה מתיקון אוטומטי")
If mila_to_remove = "" Then Exit Sub
On Error Resume Next
AutoCorrect.Entries(mila_to_remove).Delete
If Err.Number = 0 Then
deletedCount = deletedCount + 1
End If
Err.Clear
For Each p In prefixes
AutoCorrect.Entries(p & mila_to_remove).Delete
If Err.Number = 0 Then
deletedCount = deletedCount + 1
End If
Err.Clear
Next p
On Error GoTo 0
If deletedCount > 0 Then
MsgBox deletedCount & " רשומות הקשורות ל-'" & mila_to_remove & "' הוסרו בהצלחה.", _
vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ההסרה הושלמה"
Else
MsgBox "הערך '" & mila_to_remove & "' (וכל תחילית קשורה) לא נמצא ברשימת התיקונים האוטומטיים.", _
vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "לא נמצא ערך"
End If
End Sub
Sub תיקון_אוטומטי_ייבוא_מטבלה_שדרוג()
Dim tbl As Table
Dim i As Long
Dim mila As String, tikun As String
Dim prefixes As Variant, p As Variant
Dim totalRows As Long, processedCount As Long, updatedCount As Long
Dim isUpdate As Boolean
If ActiveDocument.Tables.Count = 0 Then
MsgBox "לא נמצאה טבלה במסמך הפעיל.", _
vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "שגיאה: לא נמצאה טבלה"
Exit Sub
End If
If MsgBox("מאקרו זה ישדרג את כל הערכים מהטבלה (יוסיף חדשים, יעדכן קיימים, ויוסיף לכולם תחיליות).", _
vbYesNo + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading, "אישור שדרוג") = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
prefixes = Array("ש", "ו", "ה", "שה", "כשה", "מ", "ד", "ל", "כ", "דה")
Set tbl = ActiveDocument.Tables(1)
totalRows = tbl.Rows.Count
processedCount = 0
updatedCount = 0
For i = 2 To totalRows
Application.StatusBar = "מעבד שורה " & i - 1 & " מתוך " & totalRows - 1 & "..."
mila = Trim(Left(tbl.Cell(i, 1).Range.Text, Len(tbl.Cell(i, 1).Range.Text) - 2))
tikun = Trim(Left(tbl.Cell(i, 2).Range.Text, Len(tbl.Cell(i, 2).Range.Text) - 2))
If Len(mila) > 0 And Len(tikun) > 0 Then
isUpdate = False
On Error Resume Next
Dim dummyValue As String
dummyValue = AutoCorrect.Entries(mila).value
If Err.Number = 0 Then
isUpdate = True
End If
Err.Clear
On Error GoTo 0
If isUpdate Then
updatedCount = updatedCount + 1
AutoCorrect.Entries(mila).Delete
End If
AutoCorrect.Entries.Add Name:=mila, value:=tikun
For Each p In prefixes
On Error Resume Next
AutoCorrect.Entries(p & mila).Delete
On Error GoTo 0
AutoCorrect.Entries.Add Name:=(p & mila), value:=(p & tikun)
Next p
processedCount = processedCount + 1
End If
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "תהליך השדרוג הסתיים בהצלחה!" & vbCrLf & vbCrLf & _
processedCount & " ערכים מהטבלה עובדו." & vbCrLf & _
updatedCount & " מתוכם היו עדכונים לערכים קיימים.", _
vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "השדרוג הושלם"
End Sub
Sub תיקון_אוטומטי_ייצוא_רשימה_לטבלה()
Dim entry As AutoCorrectEntry
Dim tbl As Table
Dim msg As String
Dim totalEntries As Long, i As Long
If Not ActiveDocument Is Nothing Then
msg = "מאקרו זה ייצור טבלה במסמך הנוכחי עם כל רשימת התיקונים האוטומטיים שלך." & vbCrLf & _
"מומלץ להפעיל אותו במסמך חדש וריק." & vbCrLf & vbCrLf & "להמשיך?"
If MsgBox(msg, vbYesNo + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ייצוא רשימה") = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
totalEntries = Application.AutoCorrect.Entries.Count
If totalEntries = 0 Then
MsgBox "לא נמצאו רשומות תיקון אוטומטי לייצא.", _
vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "אין רשומות"
Application.ScreenUpdating = True
Exit Sub
End If
Set tbl = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=totalEntries + 1, NumColumns:=2)
With tbl
.Borders.Enable = True
.AllowAutoFit = False
.Columns(1).SetWidth CentimetersToPoints(6), wdAdjustNone
.Columns(2).SetWidth CentimetersToPoints(8), wdAdjustNone
.Range.Cells.VerticalAlignment = wdAlignVerticalCenter
.Rows.Alignment = wdAlignRowCenter
With .Range.ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 0
.LineSpacingRule = wdLineSpaceSingle
End With
End With
With tbl.Rows(1)
.Range.Font.Size = 14
.Range.Font.Bold = True
.Range.Font.BoldBi = True
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Shading.BackgroundPatternColor = wdColorGray15
.Cells(1).Range.Text = "החלף (טקסט שגוי)"
.Cells(2).Range.Text = "ב- (טקסט מתוקן)"
End With
i = 1
For Each entry In Application.AutoCorrect.Entries
i = i + 1
Application.StatusBar = "מייצא רשומה " & i - 1 & " מתוך " & totalEntries & "..."
With tbl.Rows(i)
.Range.Font.Bold = False
.Range.Font.BoldBi = False
.Range.Font.Size = 11
.Range.ParagraphFormat.Alignment = wdAlignParagraphRight
If i Mod 2 = 0 Then
.Shading.BackgroundPatternColor = wdColorGray05
End If
.Cells(1).Range.Text = entry.Name
.Cells(2).Range.Text = entry.value
End With
Next entry
Application.StatusBar = False
Application.ScreenUpdating = True
tbl.Select
DoEvents
Selection.Collapse Direction:=wdCollapseStart
MsgBox totalEntries & " רשומות יוצאו בהצלחה לטבלה.", _
vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "הייצוא הושלם"
End If
End Sub
Sub תיקון_אוטומטי_ייבוא_מטבלה_איפוס()
Dim tbl As Table
Dim i As Long, j As Long ' הוספנו את j עבור לולאת המחיקה
Dim totalRows As Long
Dim mila As String, tikun As String
Dim importedCount As Long, deletedCount As Long
If ActiveDocument.Tables.Count = 0 Then
MsgBox "לא נמצאה טבלה במסמך הפעיל.", _
vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "שגיאה: לא נמצאה טבלה"
Exit Sub
End If
If MsgBox("אזהרה!" & vbCrLf & vbCrLf & _
"פעולה זו תמחק **לחלוטין** את כל רשימת התיקונים הקיימת שלך, " & _
"ותחליף אותה רק בערכים מהטבלה." & vbCrLf & _
"הפעולה אינה ניתנת לביטול." & vbCrLf & vbCrLf & _
"האם אתה בטוח שברצונך להמשיך?", _
vbYesNo + vbCritical + vbDefaultButton2 + vbMsgBoxRight + vbMsgBoxRtlReading, _
"אישור איפוס מלא") = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
deletedCount = AutoCorrect.Entries.Count
For j = deletedCount To 1 Step -1
Application.StatusBar = "מוחק רשומה ישנה " & (deletedCount - j + 1) & " מתוך " & deletedCount & "..."
AutoCorrect.Entries(j).Delete
Next j
Set tbl = ActiveDocument.Tables(1)
totalRows = tbl.Rows.Count
importedCount = 0
For i = 2 To totalRows
Application.StatusBar = "מייבא רשומה " & i - 1 & " מתוך " & totalRows - 1 & "..."
mila = Trim(Left(tbl.Cell(i, 1).Range.Text, Len(tbl.Cell(i, 1).Range.Text) - 2))
tikun = Trim(Left(tbl.Cell(i, 2).Range.Text, Len(tbl.Cell(i, 2).Range.Text) - 2))
If Len(mila) > 0 And Len(tikun) > 0 Then
On Error Resume Next
AutoCorrect.Entries.Add Name:=mila, value:=tikun
If Err.Number = 0 Then
importedCount = importedCount + 1
Else
Err.Clear
End If
On Error GoTo 0
End If
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "התהליך הושלם בהצלחה!" & vbCrLf & vbCrLf & _
deletedCount & " רשומות ישנות נמחקו." & vbCrLf & _
importedCount & " רשומות חדשות יובאו מהטבלה.", _
vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "איפוס וייבוא הושלמו"
End Sub
 { const baseUrl = "https://www.google.co.il/search?q=site:mitmachim.top"; const m = location.pathname.match(/^\/(topic|category)\/(\d+)/); const type = m ? m[1] : null; const id = m ? m[2] : null; let searchInput; function search(path = "") { const query = searchInput.value.trim(); if (query) { window.open(`${baseUrl}${path}%20${encodeURIComponent(query)}`, "_blank"); } } let buttons = {}; buttons.searchAll = { id: "bb-search-all", label: `חיפוש ${type ? "בכל הפורום" : ""}`, className: type ? "btn-secondary" : "btn-primary", callback: () => search(), }; if (type === "topic") { buttons.searchTopic = { label: "חיפוש בנושא זה", className: "btn-primary", callback: () => search(`/topic/${id}`), }; } else if (type === "category") { buttons.searchCategory = { label: "חיפוש בקטגוריה זו", className: "btn-primary", callback: () => search(`/category/${id}`), }; } buttons.cancel = { label: "ביטול", className: "btn-default", "data-bs-dismiss": "modal" }; const dialog = bootbox.dialog({ title: '<div style="text-align:center;"><img src="/assets/uploads/files/1625950269825-mt-google.png" width="400" alt="חיפוש בגוגל"></div>', message: '<input id="bb-inp" class="bootbox-input bootbox-input-text form-control" placeholder="הקלידו כדי לחפש בגוגל" autocomplete="off"/>', buttons, backdrop: true, show: true, onEscape: true }); dialog.on("shown.bs.modal", function () { searchInput = document.getElementById("bb-inp"); if (searchInput) { searchInput.focus(); searchInput.addEventListener("keydown", function (e) { if (e.key === "Enter") { e.preventDefault(); const query = this.value.trim(); if (query) { search(); dialog.modal("hide"); } } else if (e.key === "Escape") { e.preventDefault(); dialog.modal("hide"); } }); } const searchAllButton = document.getElementById("bb-search-all"); if (searchAllButton) { searchAllButton.title = "לחצו על אנטר כדי לחפש"; } }); })(); void 0;){kind=link}