כמה תוספים לוורד

• הקטנת סוגריים
• הכנסת הפניות בקלות ובין שני קבצים
• עדכון הפניות
• מעבר בין קטעים

הורדה מכאן

סרטון הדגמה

הסיסמה 1234

קוד פתוח תעשו בה מה שתרצו

שני קורסים בעברית לשפת תכנות של מיקרוסופט אופיס - VBA

• משירות התעסוקה הישראלי.
• excel.kova.

קישור לתיקייה בדרייב עם שני הקורסים.
קישור להורדה ישירה לקורס שירות התעסוקה הישראלי.
קישור להורדה ישירה לקורס excel.kova.

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

@שמעלקא-0

תודה ל @NykUser שכתב את הפוסט הזה, שהועיל לי בענין ההתקנה.

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

לחברים המומחים ב-VBA:
הקובץ הוא גירסה ראשונית, שעובדת יפה.
אך יש כמה דברים שעשויים לתקוע את הקוד, ואבקש את עזרת המומחים בשיפורו:

אשמח לעזור למי שעוזר לאחרים!

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

שומרים זאת בתוך הregistry זהו דוגמה

Spoiler

System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\WordVBA_LineToLine", "Max") = "5"
MsgBox (System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\WordVBA_LineToLine", "Max"))

ב. האם יש פונקציה שבודקת האם אני בטור הראשון או השני.

בעבר חיפשתי פונקציית vba מובנית ולא מצאתי, מישהו יודע?
זוהי פונקציה שכתבתי שמחזירה את ההפרש בין טור 1 ל-2, זה כנראה יענה על הצורך שלך.

Spoiler

Public Sub tryout()
    MsgBox (ColumnsDifference)
End Sub
Public Function ColumnsDifference() As Double
If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("More then 2 Columns"): Exit Function
Application.ScreenUpdating = False
Dim WRange As Range
Dim NumLines, WPage, i, col1, col2, Difference, Ignore As Double
NumLines = ActiveDocument.Bookmarks("\page").Range.ComputeStatistics(wdStatisticLines)
ActiveDocument.Bookmarks("\page").Range.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Set WRange = ActiveDocument.Bookmarks("\page").Range
WRange.SetRange START:=WRange.End - 2, End:=WRange.End
col2 = WRange.Information(wdVerticalPositionRelativeToPage)
For i = 1 To NumLines
    Selection.MoveDown wdLine, 1
    If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
        Exit For
    Else
        col1 = Selection.Information(wdVerticalPositionRelativeToPage)
    End If
Next
ActiveDocument.Bookmarks("\page").Range.Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1
If col1 > col2 Then Difference = col1 - col2
If col1 < col2 Then Difference = col2 - col1
ColumnsDifference = Difference
Application.ScreenUpdating = True
End Function

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

הראשון למספר מתחילת הקובץ, השני לדף זה (המספר מתחיל באפס כרגיל בקוד)

Spoiler

Set MyRange = Selection.Range
MyRange.SetRange START:=ActiveDocument.Paragraphs(1).Range.START, End:=MyRange.End
MsgBox (MyRange.ComputeStatistics(wdStatisticParagraphs))

Set MyRange = Selection.Range
MyRange.SetRange START:=ActiveDocument.Bookmarks("\page").Range.START, End:=MyRange.End
MsgBox (MyRange.ComputeStatistics(wdStatisticParagraphs))

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

זה

Spoiler

Set MyRange = ActiveDocument.Bookmarks("\page").Range
MyRange.SetRange START:=MyRange.End - 1, End:=MyRange.End
MyRange.Select

@נוכחות

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

Spoiler

Public Sub JoinFootnoteParagraphs()
Application.ScreenUpdating = False
If ActiveWindow.ActivePane.View.Type = wdPrintView Or ActiveWindow.ActivePane.View.Type = wdWebView Or ActiveWindow.ActivePane.View.Type = wdPrintPreview Then
    ActiveWindow.View.SeekView = wdSeekMainDocument
Else
    ActiveWindow.Panes(2).Close
End If

For i = 1 To ActiveDocument.ComputeStatistics(wdStatisticPages)
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=i
    FootOnPageCount = ActiveDocument.Bookmarks("\page").Range.Footnotes.Count
    
    For Each Foot In ActiveDocument.Bookmarks("\page").Range.Footnotes
        WFoot = WFoot + 1
        'Last Footnote on page
        If WFoot = FootOnPageCount Then
            WFoot = 0
            Exit For
        End If
        Foot.Range.Select
        Selection.Collapse Direction:=wdCollapseEnd
        'dose not have StyleSeparator
        If Selection.Paragraphs(1).IsStyleSeparator = False Then Selection.InsertStyleSeparator
    Next Foot
Next
Application.ScreenUpdating = True
End Sub

@es0583292679 כתב בבירור | קוד מאקרו ליישור שני טורים בוורד:

לא מבין למה זה צריך להגיע עד לרגיסטרי...

כמובן שזה תלוי לאיזה צורך הוא רוצה את זה

1. אפשר לשומר המידע בתוך משתנה גלובלי

Spoiler

2. משתנה שנשמר בקובץ וורד, כך ניתן לשמור הגדרה שונה לכל קובץ, והיא תהיה זמינה גם לאחר שסגרתם ופתחתם מחדש את הקובץ, או אפילו את המחשב

Spoiler

ActiveDocument.Variables("LineToLineMax") = "5"

For Each avar In ActiveDocument.Variables
    If avar.Name = "LineToLineMax" Then MsgBox (ActiveDocument.Variables("LineToLineMax"))
Next avar

3. ברגיסטרי כמו שכתבתי לעיל, או בכל מקום אחר כמו קובץ ini או xml וזה יהיה זמין גם בקבצים חדשים

@ששמעון כתב בבירור | קוד מאקרו ליישור שני טורים בוורד:

@NykUser כתב בבירור | קוד מאקרו ליישור שני טורים בוורד:

ומסגרת הטקסט יכולה להיות חלק מהסגנון

איך עושים דבר כזה?

כך, סליחה אצלי הכל באנגלית

@נוכחות @es0583292679 @MERS
הלולאות די פשוטות ונמצאות כבר בקוד שהעליתי למעלה, אעתיק אותן לכאן

הרץ מקרו מספר 1 כפול מספר העמודים שיש למסמך.

For i = 1 To ActiveDocument.ComputeStatistics(wdStatisticPages)
    'קוד
Next i

הרץ את מקרו מספר 3 כפול מספר ההערות שיש במסמך (אולי פחות אחד).

For Each Foot In ActiveDocument.Footnotes
    'קוד
Next Foot

@שמעלקא-0 כתב

תיבת הטקסט הנזכרת מוגדרת כשורה 1, והמילה שאחריה כשורה 2. וכשאני עובר לשורה 2 המחשב מזהה שעברו שורה אך לא ירדו למטה בדף. והוא חושב שעברתי לשורה המקבילה בעמודה השניה.

בקוד שהעליתי כאן לא יהא לך בעיה זה

@es0583292679 כתב

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

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

Spoiler

Set MyRange = Selection.Range
For i = 1 To MyRange.Paragraphs.Count
    Set para = MyRange.Paragraphs(i).Range
    If MyRange.Paragraphs(i).Alignment = wdAlignParagraphJustify = False Then GoTo nxt
    Select Case para.ComputeStatistics(wdStatisticLines)
    Case 1: GoTo nxt: 'Case 2: GoTo nxt
    Case Else
        With para: .Collapse: .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd
            If .Previous(Count:=2) = Chr(93) Or .Previous(Count:=2) = Chr(41) Then
            .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd
            End If
        .Select
        End With
        
        
        With Selection: .EndKey Unit:=wdLine
        If .Text = Chr(11) Then GoTo nxt:
        .TypeText Text:=Chr(11) & ChrW(8197)
        Set Char = Selection.Range
        .Previous.Font.Spacing = Char.Information(wdHorizontalPositionRelativeToTextBoundary) - para.Information(wdHorizontalPositionRelativeToTextBoundary)
        End With
    
    End Select
    nxt:
Next

@ששמעון אמר

נראה שזה בעיקר למשתמשי 'תג', לא?
אני עוד לא כל כך מבין איזה צורך זה בא למלאות.

כלי אחד מיעוד לתג אך השאר לוורד
הכלי להפניות שימושי במיוחד אלו ‏שהתרגלו להשתמש בו אינם מבינים איך אפשר בלעדיו

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

דוגמאות והנחיות נמצאות בקובץ

HebrewDateConverter.zip
password 1234

בהצלחה

@es0583292679

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

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

למשל שיהיה מאקרו שיחפש את התוספת וישמיט אותה...

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

Spoiler

Sub delete_Holon()
If Selection.Type = wdSelectionNormal Then
    Set MyRange = Selection.Range
        MyRange.SetRange Selection.Paragraphs.First.Range.START, Selection.Paragraphs.Last.Range.End
    Else
    Set MyRange = ActiveDocument.StoryRanges(Selection.StoryType)
End If
MyRange.find.Execute FindText:=Chr(11) & ChrW(8197), ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll
End Sub

@נוכחות כתב ב[שיתוף | והנה זה בא: הערות ברצף בוורד (בלי הפרדת פיסקאות)]

האם תוכל לכתוב כיצד לעשות את הקוד השני כפול מספר ההערות פחות שני הערות?

For i = 1 To ActiveDocument.Footnotes.Count - 2
  'קוד  
Next i

@דאנציג כתב בשיתוף | אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:

@pcinfogmach
יש מאקרו לעשיית חלון, ומחיקתו בצורה הרבה יותר טובה שכתב מיודענו @NykUser כאן חלון וכאן מחיקה (בספויילרים, בקוד לחלון חסר הפתיח). מצורף כקובץ BAS
חלון ומחיקתו.bas
והנה גם בקובץ תבנית
תבנית חלון ומחיקתו.dotm

@pcinfogmach כתב בשיתוף | אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:

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

איני יודע באיזה יישור שורה אחרונה המדבור, אני מצרף קוד לשורה אחרונה באמצע

Spoiler

cntr:
With para: .Collapse: .MoveUntil cset:=Chr(13): .Select: End With
Application.ScreenRefresh
With Selection: .HomeKey Unit:=wdLine
wdt = .PageSetup.TextColumns(Dialogs(wdDialogFormatColumns).ColumnNo).Width / 2
        With .Paragraphs.TabStops: .ClearAll: .Add Position:=(wdt), Alignment:=wdAlignTabCenter: End With
        If .Previous.Text <> Chr(11) And .Text <> Chr(13) Then .TypeText Text:=Chr(11) & vbTab
    End With
End Select

וזהו הקוד למחקו

Spoiler

MyRange.find.Execute FindText:=Chr(11) & vbTab, ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll

אפשר לשלב זאת יחד עם חלון או בלי, דאנציג כבר יסדר הדבר באופן נאה

@פלורידה אמר בלהורדה | תוספים לוורד, הקטנת סוגריים, הכנסת הפניות בקלות, ובין שני קבצים, ועוד:

פקודות מאקרו ללא זמינות

https://support.microsoft.com/he-il/office/הפיכת-פקודות-מאקרו-לזמינות-או-ללא-זמינות-בקבצי-office-12b036fd-d140-4e74-b45e-16fed1a7e5c6

@נוכחות כתב בשיתוף | והנה זה בא: הערות ברצף בוורד (בלי הפרדת פיסקאות):

@מניין נמתין לבעל הקוד המקורי שיגיד מה הוא חושב.

Next Foot

@צדיק-וטוב-לו-0 כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:

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

@pcinfogmach כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:

@צדיק-וטוב-לו-0
הערה נכונה ומי שיש לו כח לעשות זאת יישר חילו -
רק רציתי לשאול במאקרו שמוסיף אוטומטי לכאורה צריך גם לעשות אופציה שמסיר אוטומטי לא? מצד שני באפשרות זו עלולים להיווצר הרבה מאקרואים שאינם בשימוש יומיומי והם יכבידו על רשימת המאקרו ללא צורך?.

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

Spoiler

Sub add_to_startup1()

Set fs = CreateObject("Scripting.FileSystemObject")
dirFile = Dir(Application.StartupPath & "\" & ActiveDocument.AttachedTemplate.Name)
If Len(dirFile) = 0 Then
    fs.CopyFile ActiveDocument.AttachedTemplate.FullName, Application.StartupPath & "\" & ActiveDocument.AttachedTemplate.Name
    If fs.FileExists(Application.StartupPath & "\" & ActiveDocument.AttachedTemplate) = True Then
        MsgBox ActiveDocument.AttachedTemplate & " Was Copied to Start up Path"
    Else
       A = InputBox("Please copy " & ActiveDocument.AttachedTemplate & " to this folder", "Error did not copy", Application.StartupPath)
    End If
Else
    MsgBox ActiveDocument.AttachedTemplate & " Already in Startup Path remove first and repeat"
    Call Shell("explorer.exe" & " " & Application.StartupPath, vbNormalFocus)
End If
End Sub

@es0583292679 כתב

הרעיון אצלי שניתן לעצבה את כל מילות הפתיח יחד, ולא רק גופן וגודל וכו', אלא גם גובה ועובי וכו'.

@נתן-מרדכי-שלום כתב

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

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

@האדם-החושב כתב

זה מה שאני מקבל:

@שמעלקא-0 כתב

לגבי שגיאת ההתקנה הזו, אמתין ל@NykUser שכתב עבורנו את חלק הקוד הזה. תודות לו!

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