פורום אוצריא

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

Function UrlEncodeText(ByVal textToEncode As String) As String
    ' פונקציה פשוטה לקידוד טקסט עבור שימוש ב-URL
    Dim strEncoded As String
    strEncoded = textToEncode
    
    ' החלף רווחים ב-%20 (סטנדרט URL Encoding)
    strEncoded = Replace(strEncoded, " ", "%20")
    
    ' ניתן להוסיף כאן קידוד נוספים (כמו %2F עבור / אם צריך) אם הטקסט מורכב יותר.
    
    UrlEncodeText = strEncoded
End Function
 
Sub חפש_באוצריא()
    Dim selectedText As String
    Dim encodedText As String
    Dim customLink As String
    Dim userChoice As VbMsgBoxResult
    
    ' 1. קבלת הטקסט הנבחר
    selectedText = Selection.Text
 
    ' --- בדיקה ראשונית: האם הטקסט ריק? ---
    If selectedText = "" Then
        ' אם הטקסט ריק, מציגים הודעה בלבד ומסיים
        MsgBox "אנא בחר טקסט.", vbExclamation
        Exit Sub
    End If
    
    ' --- בדיקה נוספת: האם יש לפחות שני תווים? ---
    If Len(selectedText) < 2 Then
        ' אם הטקסט קיים אך קצר מדי, מציגים הודעה ומסיים
        MsgBox "אנא בחר טקסט.", vbExclamation
        Exit Sub
    End If
    
    ' אם הגענו לכאן, הטקסט תקין (לא ריק ויש לו לפחות שני תווים)
    
    ' 2. הודעת השאילתה השנייה (בדיקה אם לחפש באוצריא)
    userChoice = MsgBox("האם אתה מעוניין לחפש באוצריא?" & vbCrLf & vbCrLf & _
                        "לחץ 'כן' כדי להמשיך, לחץ 'לא' כדי לבטל.", vbYesNo + vbQuestion)
    
    If userChoice = vbNo Then
        ' אם נבחר "לא", יוצאים מהפונקציה
        Exit Sub
    ElseIf userChoice = vbYes Then
        ' 3. קידוד הטקסט
        encodedText = UrlEncodeText(selectedText)
 
        ' 4. הגדרת הקישור
         customLink = "otzaria://open/search?q=" & encodedText
 
        ' 5. הפעלת הקישור
        On Error Resume Next
        Shell "cmd /c start " & customLink, vbHide
        
        If Err.Number <> 0 Then
            MsgBox "שגיאה בניסיון לפתוח את הקישור: " & customLink & vbCrLf & "שגיאה: " & Err.Description, vbCritical
        End If
        On Error GoTo 0
    End If
    
End Sub

עובד לי מצויין

@דוד-משה-1 כתב:

@יורם כתב:

טעינת מפרשים מאוד מאוד איטית

@דוד-משה-1 כתב:

מפרשים בצד

לוקח כ3 שניות
עכ"פ אצלי לאחר אינדוקס