@דאנציג
לגבי מאקרו להוספת חלון שימו לב - יש להשתמש בו לפני יישור שורה אחרונה לאמצע אחרת זה ישבש לכם את המסמך.
איני יודע באיזה יישור שורה אחרונה המדבור, אני מצרף קוד לשורה אחרונה באמצע
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
@דאנציג כמדומני שיש אופציה לעשות, שאחרי פתיחת מסמך תבנית, ע"י לחיצה על צירוף מקשים - זה יוסיף את התבנית לרשימת התבניות.
איני יודע האם זה מובנה בוורד, או שזה פקודת מאקרו המשולבת בתוך התבנית.
אם יש לך מידע בנושא, ניתן פשוט לשלב אותה בכל תבנית שמעלים לשרשור ההוא, וכך להקל על האלו שמסתבכים בהוספה לוורד.
כמדומני ש @מאקרו שילב כזה דבר במקרו של הקטנת והגדלת סוגריים.
@צדיק-וטוב-לו-0
הערה נכונה ומי שיש לו כח לעשות זאת יישר חילו -
רק רציתי לשאול במאקרו שמוסיף אוטומטי לכאורה צריך גם לעשות אופציה שמסיר אוטומטי לא? מצד שני באפשרות זו עלולים להיווצר הרבה מאקרואים שאינם בשימוש יומיומי והם יכבידו על רשימת המאקרו ללא צורך?.
מצורף הקוד לזה, זה בודק האם כבר נמצא תבנית בשם זה, ובמידה שכן פתוח התקייה, כדי שיכולו למחקו אם רוצים, בעיקרון אפשר לשנות זאת שזה ימחק הישן ויעתיק החדש
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
מצד שני בתוסף שלך המילה הראשונה בדרך כלל קופצת למעלה או למטה, ואז צריך להתחיל לסדר
הכי טוב להגדיר סגנון עבור המילה הראשונה, ומסגרת הטקסט יכולה להיות חלק מהסגנון, זה יעזור כאשר תרצה לשנות הגדרה כלשהי עבור המילה הראשונה עבור הקובץ כולו.
כעת לאחר ניסוי המאקרו שלך יש לומר שהוא ממש טוב, אך לא מתאים לקובץ הניתן לשינוי, כי כל שינוי משבש את כל המסמך...
כן , כך זה בכל עימוד בוורד
יש לך מהלך שאינו משתנה עם הוספה? אדרבה!
למשל שיהיה מאקרו שיחפש את התוספת וישמיט אותה...
יש כבר, החלון הוא פשוט תו מיוחד ואפשר לחפש ולמחוק, זהו קוד שעושה את זה לכל הבחירה אם יש ואם לאו על כל המסך
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
תיבת הטקסט הנזכרת מוגדרת כשורה 1, והמילה שאחריה כשורה 2. וכשאני עובר לשורה 2 המחשב מזהה שעברו שורה אך לא ירדו למטה בדף. והוא חושב שעברתי לשורה המקבילה בעמודה השניה.
אלא שלו יש שיטה אחרת במילת הפתיח (איני יודע אם מותר לספר כיצד עובדת השיטה שלו).
אני לא יודע מה השיטה שלו, אבל יש שיטה מאוד פשוטה בלי תיבת טקסט, קוד זה יכנס חלון לכל קטע בתוך הבחירה
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
הסתכלתי במהירות על הקוד, אני לא מבין למה שינית להערות סיום.
זהו קוד קצר למדי, שעושה אותו דבר להערות שוליים, בכל הקובץ בבת אחת, הוא לא שלם עבור מה שאתה מחפש לעשות. אבל זו יכולה להיות התחלה טובה.
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
Module-level variables can be declared with a Dim or Private statement at the top of the module above the first procedure definition
Any of these will reset global variables: Using End, An unhandled runtime error, Editing code, Closing the word or file containing the VB project
משתנה שנשמר בקובץ וורד, כך ניתן לשמור הגדרה שונה לכל קובץ, והיא תהיה זמינה גם לאחר שסגרתם ופתחתם מחדש את הקובץ, או אפילו את המחשב
ActiveDocument.Variables("LineToLineMax") = "5"
כדי לקבל את המידע, תחילה עליך לבדוק אם המשתנה נמצא
For Each avar In ActiveDocument.Variables
If avar.Name = "LineToLineMax" Then MsgBox (ActiveDocument.Variables("LineToLineMax"))
Next avar
ברגיסטרי כמו שכתבתי לעיל, או בכל מקום אחר כמו קובץ ini או xml וזה יהיה זמין גם בקבצים חדשים
תודה ל @NykUser שכתב את הפוסט הזה, שהועיל לי בענין ההתקנה.
תייגת אותי, קפצתי לביקור אחרי הרבה זמן שלא הייתי כאן, מצאתי גם הרשום בקוד שלך "תודה למי שיצר את קטע הקוד הזה ואיני יודע מיהו", כתבתי הקטע ואני שמח שזה עוזר.
לחברים המומחים ב-VBA:
הקובץ הוא גירסה ראשונית, שעובדת יפה.
אך יש כמה דברים שעשויים לתקוע את הקוד, ואבקש את עזרת המומחים בשיפורו:
אשמח לעזור למי שעוזר לאחרים!
א. כדי שהטופס לא יפתח בכל הפעלה, יש צורך לשמור את הגדרות המשתמש האישיות במקור חיצוני מחוץ לקוד. אינני יודע איך עושים זאת.
ב. האם יש פונקציה שבודקת האם אני בטור הראשון או השני.
בעבר חיפשתי פונקציית vba מובנית ולא מצאתי, מישהו יודע?
זוהי פונקציה שכתבתי שמחזירה את ההפרש בין טור 1 ל-2, זה כנראה יענה על הצורך שלך.
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
ג. האם יש פונקציה פשוטה שמחזירה את מספר הפיסקה שלי.
הראשון למספר מתחילת הקובץ, השני לדף זה (המספר מתחיל באפס כרגיל בקוד)
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))
ד. האם יש פונקציה שמובילה אותי לשורה האחרונה בעמוד.
זה
Set MyRange = ActiveDocument.Bookmarks("\page").Range
MyRange.SetRange START:=MyRange.End - 1, End:=MyRange.End
MyRange.Select