פורום אוצריא

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

@יורם כתב:

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

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

מפרשים בצד

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

באיתור לא מוצא
בראשית
ויקרא וכו
וכן לא מוצא שו"ע אורח חיים
שולחן ערוך
וכן הלאה
האם זה בעיה רק אצלי?

כן

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

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

המחבר של קש"ק נפטר לפני כמה שנים אני זוכר שהוא נפטר

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

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