דילוג לתוכן
  • חוקי הפורום
  • פופולרי
  • לא נפתר
  • משתמשים
  • חיפוש גוגל בפורום
  • צור קשר
עיצובים
  • Light
  • Cerulean
  • Cosmo
  • Flatly
  • Journal
  • Litera
  • Lumen
  • Lux
  • Materia
  • Minty
  • Morph
  • Pulse
  • Sandstone
  • Simplex
  • Sketchy
  • Spacelab
  • United
  • Yeti
  • Zephyr
  • Dark
  • Cyborg
  • Darkly
  • Quartz
  • Slate
  • Solar
  • Superhero
  • Vapor

  • ברירת מחדל (ללא עיצוב (ברירת מחדל))
  • ללא עיצוב (ברירת מחדל)
כיווץ
מתמחים טופ
  1. דף הבית
  2. תוכנות
  3. יישומי אופיס
  4. וורד
  5. עזרה הדדית - וורד
  6. שיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....

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

מתוזמן נעוץ נעול הועבר עזרה הדדית - וורד
50 פוסטים 6 כותבים 1.7k צפיות 6 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • 1 106

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

    Sub parenthesis()
    With Selection.Range
    .InsertBefore "("
    .InsertAfter ")"
    End With
    End Sub
    
    ד מנותק
    ד מנותק
    דאנציג
    כתב ב נערך לאחרונה על ידי דאנציג
    #24

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

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

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

    מ תגובה 1 תגובה אחרונה
    1
    • ד דאנציג

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

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

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

      מ מנותק
      מ מנותק
      מאקרו
      כתב ב נערך לאחרונה על ידי
      #25

      @דאנציג

      
      Selection.MoveEndWhile Cset:=" ", Count:=wdBackward
      Selection.InsertAfter (")")
      Selection.InsertBefore ("(")
      
      
      ד תגובה 1 תגובה אחרונה
      2
      • מ מאקרו

        @דאנציג

        
        Selection.MoveEndWhile Cset:=" ", Count:=wdBackward
        Selection.InsertAfter (")")
        Selection.InsertBefore ("(")
        
        
        ד מנותק
        ד מנותק
        דאנציג
        כתב ב נערך לאחרונה על ידי
        #26

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

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

        P תגובה 1 תגובה אחרונה
        1
        • ד דאנציג

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

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

          P מנותק
          P מנותק
          pcinfogmach
          מדריכים
          כתב ב נערך לאחרונה על ידי pcinfogmach
          #27

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

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

          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
          

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

          תגובה 1 תגובה אחרונה
          2
          • P pcinfogmach

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

            Option Explicit
            Sub כותרות_צד()
            
            
            Dim numColumns As Integer, currentPara As Paragraph, slctd As Range _
                    
            'set range
            Set slctd = Selection.Range
            
            'start loop
            For Each currentPara In slctd.Paragraphs
            Application.ScreenUpdating = False
            currentPara.Range.Select
            
            'get column width
                numColumns = ActiveDocument.PageSetup.TextColumns.Count
                If numColumns = 2 Then
                    Dim columnWidth As Single
                    Dim columnWidth2 As Single
                    columnWidth = ActiveDocument.PageSetup.TextColumns.Item(1).Width
                    columnWidth2 = ActiveDocument.PageSetup.TextColumns.Item(2).Width
                End If
                
            'exceptions
            If Not currentPara.Range.ComputeStatistics(wdStatisticLines) > 1 _
            Or Not currentPara.Range.ComputeStatistics(wdStatisticLines) > 2 Then GoTo nxt
            
            'Get the first sentence of the current paragraph
                Dim firstSentence As String
                Dim words() As String
                words = Split(currentPara.Range.Text, " ")
                firstSentence = words(0) & " " & words(1) & " " & words(2) & " " _
                & words(3) & " " & words(4) & " " & words(5)
                
            'get font size set box font size and calc misalignment adjustment accordingly
                Dim fontSize, x, y, z As Single
                fontSize = currentPara.Range.Font.SizeBi - 4
                x = currentPara.Range.Font.SizeBi
                y = x - 8
                z = y * 0.4
                'MsgBox z
            
            '
            'Dim spaceWidth As Double
            'spaceWidth = currentPara.Range.font.spacing
            'Dim spaceWidth As Double
            'spaceWidth = ActiveDocument.PageSetup.TextColumns.spacing / 2
            '
                
                'get middle of page
                Dim mrgn As Double
                mrgn = ActiveDocument.PageSetup.LeftMargin / 2
            
                Dim newShape As Shape
                'left column - if para calc is smaller then middle of page
                If ActiveDocument.PageSetup.PageWidth / 2 > currentPara.Range.Information(wdHorizontalPositionRelativeToPage) Then
                Set newShape = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                        Left:=currentPara.Range.Information(wdHorizontalPositionRelativeToPage) - columnWidth2 - mrgn, _
                        Top:=currentPara.Range.Information(wdVerticalPositionRelativeToPage), _
                        Width:=mrgn, Height:=50)
                    newShape.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphRight
                    End If
                    
                'right column - if para calc is larger
                If ActiveDocument.PageSetup.PageWidth / 2 < currentPara.Range.Information(wdHorizontalPositionRelativeToPage) Then
                    Set newShape = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                        Left:=currentPara.Range.Information(wdHorizontalPositionRelativeToPage), _
                        Top:=currentPara.Range.Information(wdVerticalPositionRelativeToPage), _
                        Width:=mrgn, Height:=50)
                newShape.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft
               
                End If
                   'newShape.TextFrame.MarginLeft = 0
                   'newShape.TextFrame.MarginRight = 0
                    newShape.TextFrame.MarginTop = z 'adjust misalignment
                    newShape.TextFrame.MarginBottom = 0
                    newShape.Line.Visible = msoFalse
                    newShape.TextFrame.TextRange.Text = firstSentence
                    newShape.TextFrame.TextRange.Font.SizeBi = 8
                    newShape.TextFrame.AutoSize = True
                    
            
                'tiny adjustment
                    If ActiveDocument.PageSetup.PageWidth / 2 > currentPara.Range.Information(wdHorizontalPositionRelativeToPage) Then
                    newShape.TextFrame.MarginTop = newShape.TextFrame.MarginTop - 0.1
                    Else
                    newShape.TextFrame.MarginTop = newShape.TextFrame.MarginTop - 0.05
                    newShape.TextFrame.MarginLeft = newShape.TextFrame.MarginLeft + 0.04
                    End If
                    
            nxt:
            Application.ScreenUpdating = True
            Application.ScreenRefresh
                Next currentPara
                
                End Sub
                
            Sub מחק_כותרת_צד_בכל_המסמך()
                Dim shp As Shape, i As Integer, shppos, mrgnright, mrgnleft As Single
                    
                    mrgnleft = ActiveDocument.PageSetup.LeftMargin
                    mrgnright = ActiveDocument.PageSetup.PageWidth - mrgnleft
                
                For i = ActiveDocument.Shapes.Count To 1 Step -1
                    Set shp = ActiveDocument.Shapes(i)
                    shppos = shp.TextFrame.TextRange.Information(wdHorizontalPositionRelativeToPage)
                    
                    If shppos > mrgnright Or shppos < mrgnleft _
                    And shp.Type = msoTextBox And shp.Line.Visible = msoFalse Then
                     'And shp.Width = ActiveDocument.PageSetup.LeftMargin / 2 Then
                        shp.Delete
                    End If
                
                Next i
                End Sub
            
            Sub מחק_כותרות_צד_בעמוד_זה()
            Dim shp As Shape, i, currentPage As Integer, _
            shppos, mrgnright, mrgnleft As Single
                
                mrgnleft = ActiveDocument.PageSetup.LeftMargin
                mrgnright = ActiveDocument.PageSetup.PageWidth - mrgnleft
                
                currentPage = Selection.Information(wdActiveEndPageNumber)
                Application.ScreenUpdating = False
                For Each shp In ActiveDocument.Shapes
                    shppos = shp.TextFrame.TextRange.Information(wdHorizontalPositionRelativeToPage)
                    If shp.Anchor.Information(wdActiveEndPageNumber) = currentPage And _
                    shppos > mrgnright Or shppos < mrgnleft _
                    And shp.Type = msoTextBox And shp.Line.Visible = msoFalse _
                    And shp.Anchor.Information(wdActiveEndPageNumber) = currentPage Then
                        shp.Select (False)
                    End If
                Next shp
                Application.ScreenUpdating = True
                Selection.Delete Unit:=wdCharacter, Count:=1
            End Sub
            
            
            
            
            
            
            
            menajemmendelM מנותק
            menajemmendelM מנותק
            menajemmendel
            כתב ב נערך לאחרונה על ידי menajemmendel
            #28

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

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

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

            P תגובה 1 תגובה אחרונה
            0
            • menajemmendelM menajemmendel

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

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

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

              P מנותק
              P מנותק
              pcinfogmach
              מדריכים
              כתב ב נערך לאחרונה על ידי
              #29
              פוסט זה נמחק!
              menajemmendelM תגובה 1 תגובה אחרונה
              0
              • P pcinfogmach

                פוסט זה נמחק!

                menajemmendelM מנותק
                menajemmendelM מנותק
                menajemmendel
                כתב ב נערך לאחרונה על ידי
                #30

                @pcinfogmach האם זה מה שאתה רוצה לעשות? 4fb55ffd-2eb6-46e6-8f39-b707ef152974-image.png

                P תגובה 1 תגובה אחרונה
                1
                • menajemmendelM menajemmendel

                  @pcinfogmach האם זה מה שאתה רוצה לעשות? 4fb55ffd-2eb6-46e6-8f39-b707ef152974-image.png

                  P מנותק
                  P מנותק
                  pcinfogmach
                  מדריכים
                  כתב ב נערך לאחרונה על ידי pcinfogmach
                  #31
                  פוסט זה נמחק!
                  תגובה 1 תגובה אחרונה
                  0
                  • P מנותק
                    P מנותק
                    pcinfogmach
                    מדריכים
                    כתב ב נערך לאחרונה על ידי pcinfogmach
                    #32

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

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

                    ד תגובה 1 תגובה אחרונה
                    0
                    • P pcinfogmach

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

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

                      ד מנותק
                      ד מנותק
                      דאנציג
                      כתב ב נערך לאחרונה על ידי דאנציג
                      #33

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

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

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

                      P תגובה 1 תגובה אחרונה
                      0
                      • ד דאנציג

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

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

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

                        P מנותק
                        P מנותק
                        pcinfogmach
                        מדריכים
                        כתב ב נערך לאחרונה על ידי pcinfogmach
                        #34

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

                        ד תגובה 1 תגובה אחרונה
                        0
                        • P pcinfogmach

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

                          ד מנותק
                          ד מנותק
                          דאנציג
                          כתב ב נערך לאחרונה על ידי
                          #35

                          @pcinfogmach
                          את הקובץ עם הסיומת FRX ויז'ואל בייסיק לא נותן להוסיף עם השגיאה הנ"ל.
                          הקובץ השני מוסיף את זה:
                          11b1ab36-29ef-40a4-84ee-151bf0fefb3d-image.png

                          P תגובה 1 תגובה אחרונה
                          0
                          • ד דאנציג

                            @pcinfogmach
                            את הקובץ עם הסיומת FRX ויז'ואל בייסיק לא נותן להוסיף עם השגיאה הנ"ל.
                            הקובץ השני מוסיף את זה:
                            11b1ab36-29ef-40a4-84ee-151bf0fefb3d-image.png

                            P מנותק
                            P מנותק
                            pcinfogmach
                            מדריכים
                            כתב ב נערך לאחרונה על ידי
                            #36

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

                            ד תגובה 1 תגובה אחרונה
                            0
                            • P pcinfogmach

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

                              ד מנותק
                              ד מנותק
                              דאנציג
                              כתב ב נערך לאחרונה על ידי דאנציג
                              #37

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

                              P תגובה 1 תגובה אחרונה
                              0
                              • ד דאנציג

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

                                P מנותק
                                P מנותק
                                pcinfogmach
                                מדריכים
                                כתב ב נערך לאחרונה על ידי pcinfogmach
                                #38

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

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

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

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

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

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

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

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

                                Sub Parenthesis()
                                MyParenthesis.Show
                                End Sub
                                
                                תגובה 1 תגובה אחרונה
                                0
                                • P מנותק
                                  P מנותק
                                  pcinfogmach
                                  מדריכים
                                  כתב ב נערך לאחרונה על ידי pcinfogmach
                                  #39

                                  הגדל והקטן רווחים בין מילים בפיסקאות שנבחרו
                                  עריכה: הקוד שופץ ונערך מחדש על פי ההצעה של @מאקרו
                                  עריכה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
                                  
                                  
                                  menajemmendelM תגובה 1 תגובה אחרונה
                                  2
                                  • P מנותק
                                    P מנותק
                                    pcinfogmach
                                    מדריכים
                                    כתב ב נערך לאחרונה על ידי
                                    #40

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

                                    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
                                    
                                    
                                    תגובה 1 תגובה אחרונה
                                    0
                                    • P 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
                                      
                                      
                                      menajemmendelM מנותק
                                      menajemmendelM מנותק
                                      menajemmendel
                                      כתב ב נערך לאחרונה על ידי
                                      #41

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

                                      P 2 תגובות תגובה אחרונה
                                      0
                                      • menajemmendelM menajemmendel

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

                                        P מנותק
                                        P מנותק
                                        pcinfogmach
                                        מדריכים
                                        כתב ב נערך לאחרונה על ידי pcinfogmach
                                        #42

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

                                        מ תגובה 1 תגובה אחרונה
                                        0
                                        • P pcinfogmach

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

                                          מ מנותק
                                          מ מנותק
                                          מאקרו
                                          כתב ב נערך לאחרונה על ידי
                                          #43

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

                                          תגובה 1 תגובה אחרונה
                                          1

                                          • התחברות

                                          • אין לך חשבון עדיין? הרשמה

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