וורד האשכול המרכזי לשאלות וטיפים בוורד

[צח מלול]

שלום לכולם,
האם ישנה אפשרות בתוכנה להפוך כל מספר שנמצא בטקסט, לאות המקבילה שלו בגימטריה?

 

[מתמצא]

אפשר על ידי מאקרו vba
יעזור?

 

[צח מלול]

וואי תודה רבה.
הכוונה למאקרו רגיל?

 

[השף ברון]

וואי תודה רבה.
הכוונה למאקרו רגיל?

נראה לי שכן

 

[צח מלול]

אשמח. תודה רבה

 

[צח מלול]

סליחה שאני קרציה, אבל זה קצת דחוף לי...
תודה רבה לעוזרים.

 

[הללוהו ב ו]

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

 

[חגי פאהן]

ודאי שאפשר, אבל זה קצת עבודה.

 

[הללוהו ב ו]

אשמח. תודה רבה

יש לי, שאלתי איך אתם רוצים.

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

 

[מלאכת מחשבת]

עיי' כאן ומקוה שתמצא נחת..

 

[צח מלול]

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

 

[הללוהו ב ו]

בלי גרשיים באמצע.

Sub המרת_מספרים_לאותיות()
start:
With Selection.Find
    .ClearFormatting
    .Execute findText:="[0-9]{1,}", MatchWildcards:=True, Format:=False, Wrap:=wdFindContinue
    If .Found = True Then
S = ""

MyArray = Array(400, 300, 200, 100, 90, 80, 70, 60, 50, 40, 30, 20, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
MyaArray = Array("ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", _
"י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
V = Val(Selection)
Do While V > 0
If V = 15 Or V = 16 Then
S = S & "ט"
V = V - 9
End If
  For i = 0 To UBound(MyArray)
    If V >= MyArray(i) Then
      S = S & MyaArray(i)
      V = V - MyArray(i)
      Exit For
    End If
  Next i
Loop

Selection = S

GoTo start
    End If
End With
End Sub

קרדיט ל @Yisrael

וכשזה למעלה מאלף עדיין לא הסתדרתי נחכה ונשמח לפיתרון המומחים...

 

[הללוהו ב ו]

אם אפשר שהאותיות המוחלפות מהמספרים, יהיו מוקפות בסוגריים מרובעים.
תבורך.

Sub המרת_מספרים_לאותיות_כולל_הוספת_סוגריים()
start:
With Selection.Find
    .ClearFormatting
    .Execute findText:="[0-9]{1,}", MatchWildcards:=True, Format:=False, Wrap:=wdFindContinue
    If .Found = True Then
S = ""

MyArray = Array(400, 300, 200, 100, 90, 80, 70, 60, 50, 40, 30, 20, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
MyaArray = Array("ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", _
"י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
V = Val(Selection)
Do While V > 0
If V = 15 Or V = 16 Then
S = S & "ט"
V = V - 9
End If
  For i = 0 To UBound(MyArray)
    If V >= MyArray(i) Then
      S = S & MyaArray(i)
      V = V - MyArray(i)
      Exit For
    End If
  Next i
Loop


Selection = "[" & S & "]"

GoTo start
    End If
End With
End Sub

בבקשה, ובהצלחה רבה.

 

[הללוהו ב ו]

וכשזה למעלה מאלף עדיין לא הסתדרתי נחכה ונשמח לפיתרון המומחים...

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

בינתיים אביא את מה שעקפתי...

Sub המרת_מספרים_לאותיות_כולל_הוספת_סוגריים()
start:
With Selection.Find
    .ClearFormatting
    .Execute findText:="[0-9]{1,}", MatchWildcards:=True, Format:=False, Wrap:=wdFindContinue
    If .Found = True Then
S = ""

MyArray = Array(10000, 9000, 8000, 7000, 6000, 5000, 4000, 3000, 2000, 1000, 400, 300, 200, 100, 90, 80, 70, 60, 50, 40, 30, 20, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1)
MyaArray = Array("י' ", "ט' ", "ח' ", "ז' ", "ו' ", "ה' ", "ד' ", "ג' ", "ב' ", "א' ", "ת", "ש", "ר", "ק", "צ", "פ", "ע", "ס", "נ", "מ", "ל", "כ", _
"י", "ט", "ח", "ז", "ו", "ה", "ד", "ג", "ב", "א")
V = Val(Selection)
Do While V > 0
If V = 15 Or V = 16 Then
S = S & "ט"
V = V - 9
End If
  For i = 0 To UBound(MyArray)
    If V >= MyArray(i) Then
      S = S & MyaArray(i)
      V = V - MyArray(i)
      Exit For
    End If
  Next i
Loop


Selection = "[" & S & "]"

GoTo start
    End If
End With
End Sub

 

[צח מלול]

וואו אלוף!
אני עכשיו בודק את זה.

 

[זאבי]

@צורת הדף
אולי תוכל לסייע בעד אלו שנהנים מהתוכנה Holon&Center שיתאים גם לוורד 2019
אני מאוד נהנה מזה כבר שנים רבות (לאחר תשלום 15$ כפי שבקשת)
וכעת בוורד 2019 זה לא עובד לי
מייל שלי 0573100 בגימייל

 

[ayg]

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

בהצלחה

הוסר הקובץ עקב עדכון.

 

[הללוהו ב ו]

כדי שיעבוד על הכל אפשר כך:

Public Sub EnHeb()
    Const listEn = "qwertyuiopasdfghjkl;'zxcvbnm,./()[]{}"
    Const listHeb = "/'קראטוןםפשדגכעיחלךף,זסבהנמצתץ.)(][}{"
    Dim Status As Long
    Dim i As Long
    Dim Str As String
    Dim Result As String
   Str = LCase(Selection)
    Do While Status = 0 And Mid(Str, i + 1, 1) <> ""
        If InStr(listEn, Mid(Str, i + 1, 1)) > 0 Then Status = -1
        If InStr(listHeb, Mid(Str, i + 1, 1)) > 0 Then
            If Status = -1 Then Status = 0 Else Status = 2
        Else
            Status = IIf(Status = -1, 1, 0)
        End If
        i = i + 1
    Loop
    For i = 1 To Len(Str)
        If Status = 2 Then
            If Mid(Str, i, 1) = "" Then
            ElseIf InStr(listHeb, Mid(Str, i, 1)) > 0 Then
                Result = Result & Mid(listEn, InStr(listHeb, Mid(Str, i, 1)), 1)
            ElseIf InStr(listEn, Mid(Str, i, 1)) > 0 Then
                Result = Result & Mid(listHeb, InStr(listEn, Mid(Str, i, 1)), 1)
            Else
                Result = Result & Mid(Str, i, 1)
            End If
        Else
            If Mid(Str, i, 1) = "" Then
            ElseIf InStr(listEn, Mid(Str, i, 1)) > 0 Then
                Result = Result & Mid(listHeb, InStr(listEn, Mid(Str, i, 1)), 1)
            ElseIf InStr(listHeb, Mid(Str, i, 1)) > 0 Then
                Result = Result & Mid(listEn, InStr(listHeb, Mid(Str, i, 1)), 1)
            Else
                Result = Result & Mid(Str, i, 1)
            End If
        End If
    Next i
    Selection = Result
End Sub

ובהצלחה, תעדכנו על באגים.

 

[תג]

כנראה הקובץ פגום

 

[מעמד ברמה]

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