שיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....

[pcinfogmach]

פתיחת מסמכים מרובים

Sub OpenAllDocumentsInFolder()
    Dim FolderPath As String
    Dim FileName As String
    Dim DocumentPath As String
    
    ' Select the folder containing the documents
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder"
        If .Show = -1 Then
            FolderPath = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With
    
    ' Disable screen updating for faster execution
    Application.ScreenUpdating = False
    
    ' Loop through each file in the folder
    FileName = Dir(FolderPath & "*.doc*")
    Do While FileName <> ""
        ' Construct the full path of the document
        DocumentPath = FolderPath & FileName
        
        ' Open the document
        Documents.Open FileName:=DocumentPath
        
        ' Move to the next file
        FileName = Dir
    Loop
    
    ' Enable screen updating
    Application.ScreenUpdating = True
End Sub

[106]

הכנסת טקסט נבחר (כגון מראה מקום) לתוך סוגריים.

Sub parenthesis()
With Selection.Range
.InsertBefore "("
.InsertAfter ")"
End With
End Sub

[דאנציג]

@106
@dmp הביא פה בעבר הקוד הזה:

'
' סוגריים_עגולות Macro
'
'
Selection.Text = "(" & Selection.Text & ")"
End Sub

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

[מאקרו]

@דאנציג

Selection.MoveEndWhile Cset:=" ", Count:=wdBackward
Selection.InsertAfter (")")
Selection.InsertBefore ("(")

[דאנציג]

@מאקרו
לא עובד לי.

יש לציין לתוסף המוצלח הזה שעושה זאת נפלא.

[pcinfogmach]

@דאנציג כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

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

Selection.MoveEndUntil Cset:=" ", Count:=wdForward
Selection.MoveStartUntil Cset:=" ", Count:=wdBackward
Selection.text = "(" & Selection.text & ")"

או אפשר ככה למי שמעדיף

With Selection
    .MoveEndUntil Cset:=" ", Count:=wdForward
    .MoveStartUntil Cset:=" ", Count:=wdBackward
    .text = "(" & .text & ")"
End With

משום מה במילים ארוכות באנגלית הוא עושה קצת בעיות

[menajemmendel]

@pcinfogmach כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

קוד להוספת כותרות צד

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

[pcinfogmach]

פוסט זה נמחק!

[menajemmendel]

@pcinfogmach האם זה מה שאתה רוצה לעשות?

[pcinfogmach]

פוסט זה נמחק!

[pcinfogmach]

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

עריכה: גירסה מעודכנת
MyParenthesis.zip

[דאנציג]

@pcinfogmach כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

הקטנת והגדלת סוגריים
מאחר ומדובר ביוזרפורם אני מעלה את הקובץ frm במקום קוד
Parenthesis.frm

Errors during load. Refer to
Line 8: Property OleObjectBlob in Parenthesis had an invalid file reference.

[pcinfogmach]

@דאנציג
נראה לי שיש לו קובץ תומך שהיה חסר נסה עכשיו

[דאנציג]

@pcinfogmach
את הקובץ עם הסיומת FRX ויז'ואל בייסיק לא נותן להוסיף עם השגיאה הנ"ל.
הקובץ השני מוסיף את זה:

[pcinfogmach]

@דאנציג
מצויין כמו שאמרתי ה- frx לא אמור להיות מותקן הוא רק קובץ תומך

[דאנציג]

@pcinfogmach והיכן הוא אמור להיות?
בSTARTUP, או בTemplates?
אגב, זה בדיוק הקובץ של הקטנת והגדלת סוגריים של ניקיוזר, אך אם אני לא נותן לו את פקודת המאקרו, כיצד הוא יפעל?

[pcinfogmach]

@דאנציג כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

@pcinfogmach והיכן הוא אמור להיות?
בSTARTUP, או בTemplates?

אם אתה רוצה שיאתחל עם וורד אז בstartup או פשוט תוסיף אותו לתבנית נורמל.

אגב, זה בדיוק הקובץ של הקטנת והגדלת סוגריים של ניקיוזר,

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

אך אם אני לא נותן לו את פקודת המאקרו, כיצד הוא יפעל?

צודק
היה עוד בעיה שתוקנה עכשיו עם השם של היוזרפורם

ולהוסיף בתוך מודול רגיל קוד כזה

Sub Parenthesis()
MyParenthesis.Show
End Sub

[pcinfogmach]

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

Option Explicit
Sub הגדל_רווחים_בין_מילים()
    Dim rng, para, spaceRange As Range, i As Integer
    
    Set rng = Selection.Range
    
    'loop throgh pragraphs
    For i = 1 To rng.Paragraphs.Count
    Set para = rng.Paragraphs(i).Range
    Set spaceRange = para.Duplicate
    
    ' Loop through each space in the selected paragraph
    Do While spaceRange.InRange(para)
        spaceRange.MoveStartUntil " " ' Move to the next space
            If spaceRange.InRange(para) Then _
                spaceRange.Characters(1).Font.Spacing = spaceRange.Characters(1).Font.Spacing + 1
                   spaceRange.MoveStart unit:=wdCharacter, Count:=1 ' Move to the next character
    Loop
    
    Next i
    
End Sub


Sub הקטן_רווחים_בין_מילים()
    Dim rng, para, spaceRange As Range, i As Integer
    
    Set rng = Selection.Range
    
    'loop throgh pragraphs
    For i = 1 To rng.Paragraphs.Count
    Set para = rng.Paragraphs(i).Range
    Set spaceRange = para.Duplicate
    
    ' Loop through each space in the selected paragraph
    Do While spaceRange.InRange(para)
        spaceRange.MoveStartUntil " " ' Move to the next space
            If spaceRange.InRange(para) Then _
                spaceRange.Characters(1).Font.Spacing = spaceRange.Characters(1).Font.Spacing - 1
                   spaceRange.MoveStart unit:=wdCharacter, Count:=1 ' Move to the next character
    Loop
    
    Next i
    
End Sub

עריכה 3:
והנה קוד בשיטה אחרת לפי ההצעה של @menajemmendel קוד זה נערך על ידי ושופץ בעזרת @מאקרו

Sub ChangeSpacing()
Dim myrange As Range, orange As Range
Set myrange = Selection.Range
myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End
Set orange = ActiveDocument.Range(myrange.Start, myrange.End)

With orange
.Collapse
.MoveUntil cset:=" "
.SetRange Start:=.Start, End:=.Start + 1
.Select
End With

Dim c As Font, rslt As Integer
Set c = Selection.Font
rslt = c.Spacing + 1

With myrange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Font.Spacing = rslt
.Text = " "
.Replacement.Text = "^&"
.Forward = False
.Wrap = wdFindStop
.Format = True
End With
myrange.Find.Execute Replace:=wdReplaceAll
End Sub

[pcinfogmach]

הסרת כל הרווחים בטקסט שסומן

Sub DeleteSpacesInParagraph()
    Dim rng As Range
    
    ' Set the range to the current paragraph
    Set rng = Selection.Range
    
    ' Remove all spaces
    rng.text = Replace(rng.text, " ", "")
    
End Sub

[menajemmendel]

@pcinfogmach למה בלופ, מה רע לך בחפש והחלף? וכי הוא לא יותר מהיר?