תחומים - פורום חרדי מקצועי

מצאתי אצלי משהו, אבל נראה לי די ישן, אז כנראה לא מתאים למה שהתחדש.

Public Function fCheckBankAccountValidity(lngBankNumber As Long, _
                                          lngBranch As Long, _
                                          lngAccount As Long) As Boolean
  On Error GoTo Err_בדיקה
    
    fCheckBankAccountValidity = 0

    Dim lngRequiredAccountLength As Long
    Dim lngTotal As Long

    Dim strArrayAccount() As String
    Dim strArrayBranch() As String

    Dim strAccount As String
    Dim strBranch As String

    Select Case lngBankNumber
        Case 10, 13, 34
            lngRequiredAccountLength = 8
        Case 12, 4
            lngRequiredAccountLength = 6
        Case 11, 17
            lngRequiredAccountLength = 9
        Case 20
            lngRequiredAccountLength = 6
        Case 31, 52
            lngRequiredAccountLength = 9
        Case 9
            lngRequiredAccountLength = 9
        Case 22
            lngRequiredAccountLength = 9
        Case 46
            lngRequiredAccountLength = 9
        Case 14
            lngRequiredAccountLength = 9
        Case 54
            lngRequiredAccountLength = 9
    End Select
    strBranch = lngBranch
    strAccount = String(lngRequiredAccountLength - Len(CStr(lngAccount)), "0") & CStr(lngAccount)
'    strAccount = Right("0000000000" & CStr(lngAccount), lngRequiredAccountLength) ' This is an alternative to the previous line
    strAccount = StrConv(strAccount, vbUnicode)
    strArrayAccount = Split(strAccount, vbNullChar)

    If lngBankNumber = 20 And lngBranch > 400 Then    ' אם מספר הסניף בבנק מזרחי-טפחות גדול מ400
        strBranch = CStr(lngBranch - 400)    ' לפני החישובים יש להפחית 400
    End If
If lngBankNumber = 20 And lngBranch < 400 Then    ' אם מספר הסניף בבנק מזרחי-טפחות לא גדול מ400
        strBranch = CStr(lngBranch)    ' לפני החישובים אל תבצע כלום
    End If
    If lngBankNumber = 12 Or lngBankNumber = 4 Then
        strBranch = lngBranch
    End If

    If Len(strBranch) < 3 Then
        strBranch = String(3 - Len(strBranch), "0") & strBranch    ' מוסיף אפסים להשלים ל3 ספרות
    End If
     strBranch = StrConv(strBranch, vbUnicode)
     strArrayBranch = Split(strBranch, vbNullChar)

    Select Case lngBankNumber
        Case 10, 13, 34
    
        lngTotal = CLng(strArrayBranch(0)) * 10 + _
                   CLng(strArrayBranch(1)) * 9 + _
                   CLng(strArrayBranch(2)) * 8 + _
                   CLng(strArrayAccount(0)) * 7 + _
                   CLng(strArrayAccount(1)) * 6 + _
                   CLng(strArrayAccount(2)) * 5 + _
                   CLng(strArrayAccount(3)) * 4 + _
                   CLng(strArrayAccount(4)) * 3 + _
                   CLng(strArrayAccount(5)) * 2 + _
                   right(lngAccount, 2)
          Select Case right(lngTotal, 2)
              Case 90, 72, 70, 60, 20
             fCheckBankAccountValidity = 1
          End Select
        
        Case 12
            lngTotal = CLng(strArrayBranch(0)) * 9 + _
                       CLng(strArrayBranch(1)) * 8 + _
                       CLng(strArrayBranch(2)) * 7 + _
                       CLng(strArrayAccount(0)) * 6 + _
                       CLng(strArrayAccount(1)) * 5 + _
                       CLng(strArrayAccount(2)) * 4 + _
                       CLng(strArrayAccount(3)) * 3 + _
                       CLng(strArrayAccount(4)) * 2 + _
                       CLng(strArrayAccount(5)) * 1
            Select Case lngTotal Mod 11
                Case 0, 2, 4, 6
                    fCheckBankAccountValidity = 1
               
            Case Else
                    fCheckBankAccountValidity = 0
            End Select
            
           Case 4
            lngTotal = CLng(strArrayBranch(0)) * 9 + _
                       CLng(strArrayBranch(1)) * 8 + _
                       CLng(strArrayBranch(2)) * 7 + _
                       CLng(strArrayAccount(0)) * 6 + _
                       CLng(strArrayAccount(1)) * 5 + _
                       CLng(strArrayAccount(2)) * 4 + _
                       CLng(strArrayAccount(3)) * 3 + _
                       CLng(strArrayAccount(4)) * 2 + _
                       CLng(strArrayAccount(5)) * 1
            Select Case lngTotal Mod 11
                Case 0, 2
                    fCheckBankAccountValidity = 1
            Case Else
                    fCheckBankAccountValidity = 0
            End Select
        Case 11, 17
            lngTotal = CLng(strArrayAccount(0)) * 9 + _
                       CLng(strArrayAccount(1)) * 8 + _
                       CLng(strArrayAccount(2)) * 7 + _
                       CLng(strArrayAccount(3)) * 6 + _
                       CLng(strArrayAccount(4)) * 5 + _
                       CLng(strArrayAccount(5)) * 4 + _
                       CLng(strArrayAccount(6)) * 3 + _
                       CLng(strArrayAccount(7)) * 2 + _
                       CLng(strArrayAccount(8)) * 1
            Select Case lngTotal Mod 11
                Case 0, 2, 4
                    fCheckBankAccountValidity = 1
            End Select
        Case 20
            lngTotal = CLng(strArrayBranch(0)) * 9 + _
                       CLng(strArrayBranch(1)) * 8 + _
                       CLng(strArrayBranch(2)) * 7 + _
                       CLng(strArrayAccount(0)) * 6 + _
                       CLng(strArrayAccount(1)) * 5 + _
                       CLng(strArrayAccount(2)) * 4 + _
                       CLng(strArrayAccount(3)) * 3 + _
                       CLng(strArrayAccount(4)) * 2 + _
                       CLng(strArrayAccount(5)) * 1
            Select Case lngTotal Mod 11
                Case 0, 2, 4
                    fCheckBankAccountValidity = 1
            End Select
        Case 31, 52
            lngTotal = CLng(strArrayAccount(0)) * 9 + _
                       CLng(strArrayAccount(1)) * 8 + _
                       CLng(strArrayAccount(2)) * 7 + _
                       CLng(strArrayAccount(3)) * 6 + _
                       CLng(strArrayAccount(4)) * 5 + _
                       CLng(strArrayAccount(5)) * 4 + _
                       CLng(strArrayAccount(6)) * 3 + _
                       CLng(strArrayAccount(7)) * 2 + _
                       CLng(strArrayAccount(8)) * 1
            Select Case lngTotal Mod 11
                Case 0
                    fCheckBankAccountValidity = 1
                Case 6
                    fCheckBankAccountValidity = 1
                Case Else
                    lngTotal = CLng(strArrayAccount(3)) * 6 + _
                               CLng(strArrayAccount(4)) * 5 + _
                               CLng(strArrayAccount(5)) * 4 + _
                               CLng(strArrayAccount(6)) * 3 + _
                               CLng(strArrayAccount(7)) * 2 + _
                               CLng(strArrayAccount(8)) * 1
                    Select Case lngTotal Mod 11
                      Case 0
                    fCheckBankAccountValidity = 1
                      Case 6
                    fCheckBankAccountValidity = 1
                     End Select
             End Select
        Case 9
            lngTotal = CLng(strArrayAccount(0)) * 9 + _
                       CLng(strArrayAccount(1)) * 8 + _
                       CLng(strArrayAccount(2)) * 7 + _
                       CLng(strArrayAccount(3)) * 6 + _
                       CLng(strArrayAccount(4)) * 5 + _
                       CLng(strArrayAccount(5)) * 4 + _
                       CLng(strArrayAccount(6)) * 3 + _
                       CLng(strArrayAccount(7)) * 2 + _
                       CLng(strArrayAccount(8)) * 1
            If lngTotal Mod 10 = 0 Then
                fCheckBankAccountValidity = 1
            End If
        Case 54
                 fCheckBankAccountValidity = 1
       Case 22
            lngTotal = CLng(strArrayAccount(0)) * 3 + _
                       CLng(strArrayAccount(1)) * 2 + _
                       CLng(strArrayAccount(2)) * 7 + _
                       CLng(strArrayAccount(3)) * 6 + _
                       CLng(strArrayAccount(4)) * 5 + _
                       CLng(strArrayAccount(5)) * 4 + _
                       CLng(strArrayAccount(6)) * 3 + _
                       CLng(strArrayAccount(7)) * 2
            If 11 - (lngTotal Mod 11) = CLng(strArrayAccount(8)) Then
                fCheckBankAccountValidity = 1
            End If
        Case 46
            lngTotal = CLng(strArrayBranch(0)) * 9 + _
                       CLng(strArrayBranch(1)) * 8 + _
                       CLng(strArrayBranch(2)) * 7 + _
                       CLng(strArrayAccount(3)) * 6 + _
                       CLng(strArrayAccount(4)) * 5 + _
                       CLng(strArrayAccount(5)) * 4 + _
                       CLng(strArrayAccount(6)) * 3 + _
                       CLng(strArrayAccount(7)) * 2 + _
                       CLng(strArrayAccount(8)) * 1
              Select Case lngTotal Mod 11
                Case 0
                    fCheckBankAccountValidity = 1
                Case 2
                    Select Case strBranch
                        Case 154, 166, 178, 181, 183, 191, 192, 503, 505, 507, 515, 516, 527, 539
                            fCheckBankAccountValidity = 1
                    End Select
                Case Else
                    lngTotal = CLng(strArrayAccount(0)) * 9 + _
                               CLng(strArrayAccount(1)) * 8 + _
                               CLng(strArrayAccount(2)) * 7 + _
                               CLng(strArrayAccount(3)) * 6 + _
                               CLng(strArrayAccount(4)) * 5 + _
                               CLng(strArrayAccount(5)) * 4 + _
                               CLng(strArrayAccount(6)) * 3 + _
                               CLng(strArrayAccount(7)) * 2 + _
                               CLng(strArrayAccount(8)) * 1
                    If lngTotal Mod 11 = 0 Then
                        fCheckBankAccountValidity = 1
                    Else
                        lngTotal = CLng(strArrayAccount(3)) * 6 + _
                                   CLng(strArrayAccount(4)) * 5 + _
                                   CLng(strArrayAccount(5)) * 4 + _
                                   CLng(strArrayAccount(6)) * 3 + _
                                   CLng(strArrayAccount(7)) * 2 + _
                                   CLng(strArrayAccount(8)) * 1
                        If lngTotal Mod 11 = 0 Then
                            fCheckBankAccountValidity = 1
                        End If
                    End If
            End Select
        Case 14
            lngTotal = CLng(strArrayBranch(0)) * 9 + _
                       CLng(strArrayBranch(1)) * 8 + _
                       CLng(strArrayBranch(2)) * 7 + _
                       CLng(strArrayAccount(3)) * 6 + _
                       CLng(strArrayAccount(4)) * 5 + _
                       CLng(strArrayAccount(5)) * 4 + _
                       CLng(strArrayAccount(6)) * 3 + _
                       CLng(strArrayAccount(7)) * 2 + _
                       CLng(strArrayAccount(8)) * 1
            Select Case lngTotal Mod 11
                Case 0
                    fCheckBankAccountValidity = 1
                Case 2
                    Select Case strBranch
                        Case 347, 361, 362, 363, 365, 385
                            fCheckBankAccountValidity = 1
                    End Select
                Case 4
                    Select Case strBranch
                        Case 361, 362, 363
                            fCheckBankAccountValidity = 1
                    End Select
                Case Else
                    lngTotal = CLng(strArrayAccount(0)) * 9 + _
                               CLng(strArrayAccount(1)) * 8 + _
                               CLng(strArrayAccount(2)) * 7 + _
                               CLng(strArrayAccount(3)) * 6 + _
                               CLng(strArrayAccount(4)) * 5 + _
                               CLng(strArrayAccount(5)) * 4 + _
                               CLng(strArrayAccount(6)) * 3 + _
                               CLng(strArrayAccount(7)) * 2 + _
                               CLng(strArrayAccount(8)) * 1
                    If lngTotal Mod 11 = 0 Then
                        fCheckBankAccountValidity = 1
                    Else
                        lngTotal = CLng(strArrayAccount(3)) * 6 + _
                                   CLng(strArrayAccount(4)) * 5 + _
                                   CLng(strArrayAccount(5)) * 4 + _
                                   CLng(strArrayAccount(6)) * 3 + _
                                   CLng(strArrayAccount(7)) * 2 + _
                                   CLng(strArrayAccount(8)) * 1
                        If lngTotal Mod 11 = 0 Then
                            fCheckBankAccountValidity = 1
                        End If
                    End If
            End Select
    End Select

Exit_fCheckBankAccountValidity:
    Exit Function

Err_בדיקה:
    
     fCheckBankAccountValidity = 2
    Exit Function

End Function

Public Function fCheckBankAccountValidityTest()
Debug.Print fCheckBankAccountValidity("4", "129", "100477")
End Function

הנה קוד לדוגמא:

Public Function אימות_סניף()
Dim Request As MSXML2.ServerXMLHTTP60
Dim Json As Object
Dim item As Variant

Set Request = New ServerXMLHTTP60
With Request
    .Open "GET", "https://data.gov.il/api/action/datastore_search?resource_id=1c5bc716-8210-4ec7-85be-92e6271955c2&filters={""Bank_Code"":""52"",""Branch_Code"":""172""}", False
    .send
    Set Json = JsonConverter.ParseJson(.responseText)
End With

If Json("success") <> "true" Then
    MsgBox "התרחשה שגיאה, פרטי השגיאה: סוג - " & Json("error")("__type") & ", הודעה - " & Json("error")("message")
ElseIf Json("result")("total") = 0 Then
    MsgBox "הבקשה לא החזירה תוצאות"
Else
    For Each item In Json("result")("records")
        MsgBox item("Bank_Name") & " - " & item("Branch_Name") & " - " & item("Branch_Code")
    Next item
End If

End Function

הערה. אני משתמש בקוד JsonConverter בשביל לקרוא טוב את התשובה.

@מטעמים אתה יכול גם לעשות קוד VBA שיבדוק עם API של בנק ישראל.
לדוג' הבקשה הבאה:
https://data.gov.il/api/action/datastore_search?resource_id=1c5bc716-8210-4ec7-85be-92e6271955c2&filters={"Bank_Code":"52","Branch_Code":"172"}
תבדוק האם קוד בנק 52 (פאג"י) וקוד סניף 172 נכונה. במידה וכן היא תחזיר את פרטי הסניף.
זה לא יעזור לך לבדוק נכונות של פרטי החשבון, רק מספר בנק וסניף.

תודה.

@צדיק-תמים כתב בתוכנה להמרת אודיו לטקסט:

אם זה בהגיה אשכנזית-חסידית

זה בהגיה ליטאית. יותר טוב?

שלום רב.
אני מחפש תוכנה להמרת קבצי שמע לטקסט.
מדובר על שיעורים תורניים.
שמעתי על התוכנה הזו https://app.transkriptor.com מישהו מכיר? או משהו אחר מניסיון?
תודה רבה.

@מנחם תודה.
זה הרבה יותר יעיל ממה שאני כתבתי.

עריכה: סתם בשביל הסקרנות בדקתי...
הקוד שלי לקח על 50 רשומות משיטס 4 שניות, ושלך 3 שניות.
אז בזמן זה לא כ"כ משמעותי (לא אמור להיות בקובץ יותר מכמה עשרות רשומות), אבל זה בהחלט יותר פשוט ויעיל.

@avi-rz כתב בנתונים לאקסס מאנדרואיד:

איך? ע"י פרסום באינטרנט?

אכן

@avi-rz כתב בנתונים לאקסס מאנדרואיד:

להוי ידוע שזה פתוח לכל מאן דבעי - בלי הרשאות גישה.

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

@avi-rz כתב בנתונים לאקסס מאנדרואיד:

צעה רעיונית - ללא נסיון"

מעניין. ננסה.

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

Public Function GetNewData()
Dim XL As Excel.Application, WB As Excel.Workbook
Dim WKS As Excel.Worksheet
Dim path As String

'קובץ האקסל עם חיבור לגוגל שיטס
path = "C:\Users\1\Downloads\חוברת1.xlsm"

'פתח את קובץ האקסל כדי לרענן את הנתונים
Set XL = New Excel.Application
XL.Visible = False
Set WB = XL.Workbooks.Open(path)
Set WKS = WB.Worksheets(1)
WKS.QueryTables.Item(1).Refresh

'המתן לסיום הריענון
Sleep (2000)

'יבא את הנתונים לטבלה חדשה זמנית
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "חדשים", path, True

'סגור את הקובץ ונקה את המשתנים
WB.Close False

Set XL = Nothing
Set WB = Nothing
Set WKS = Nothing

'יבא נתונים חדשים מהטבלה הזמנית לטבלת הנתונים
CurrentDb.Execute "INSERT INTO נתונים SELECT חדשים.* FROM חדשים LEFT JOIN נתונים ON (חדשים.תאריך = נתונים.תאריך) AND (חדשים.טלפון = נתונים.טלפון) AND (חדשים.[שם פרטי] = נתונים.[שם פרטי]) AND (חדשים.[שם משפחה] = נתונים.[שם משפחה]) AND (חדשים.[חותמת זמן] = נתונים.[חותמת זמן]) WHERE (((נתונים.[חותמת זמן]) Is Null))"

'מחק את הטבלה הזמנית
DoCmd.DeleteObject acTable, "חדשים"

End Function

כמו שאמרתי, ברור שזה לא דרך המלך, אבל כרגע זה מה שאני יודע.
מה דעתכם על זה?
תודה.

תודה לכולם.
@צדיק-תמים אני לא חושב ששייך באקסס לקבל וובהוק בלי קוד שירוץ כל הזמן בפועל.
@avi-rz אני צריך טופס די מינימלי של קבלת כמה נתונים, לא משהו מורכב מדי

@dovid אתה חושב שקוד נוד יהיה יעיל יותר מVBA? איפה לכתוב אותו - בגוגל סקריפט?
אפשר בבקשה מראי מקומות שאני אתחיל לבדוק מה אני מבין לבד.

שוב תודה!

@dovid כתב בנתונים לאקסס מאנדרואיד:

אתה יכול להשתמש בגוגל פרומס,
אבל עדיין לסנכרן את זה עם אקסס בקלות על ידי קוד שאיננו VBA

זה נשמע מעניין בהחלט.
מאיפה להתחיל?

@dovid כתב בנתונים לאקסס מאנדרואיד:

אתה צריך ללמוד קצת תכנות לאינטרנט

איזה סוג של תכנות?
נשמע לי קצת מורכב לבנות אתר/אפליקציה בשביל זה.

שבוע טוב.
אני צריך לבנות תוכנה באקסס, שיהי אפשרות להזין נתונים אליה גם מאנדרואיד.
אני יודע שאין איך להריץ אקסס באנדרואיד, אבל אני מחפש אפשרות רק להזין נתונים לתוכנה אפי' בלי הטפסים שלה.
חשבתי על אופציה (לא בדקתי עדיין בפועל) לבנות את התוכנה באקסס, ולעשות טופס גוגל עם השדות כמו בתוכנה, ולהגדיר שישמור את הנתונים בגוגל שיטס (אני חושב שיש אפשרות כזו), ואז באקסס לכתוב איזה קוד שייבא את הנתונים מהשיטס לתוכנה.
נראה לכם משהו שיכול לעבוד? או שיש למישהו רעיון אחר?
תודה!

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

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

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

@אביי כתב בקובץ PDF משובש בשמירה מVBA אקסס:

נסה לראות האם זה פותר לך את הבעיה

זה לא עזר.

אני לא רואה במאפיינים איך הוא נוצר.
תודה.

@מלא אם בקובץ וורד עצמו אני עושה שמירה כקובץ PDF זה יוצא משובש, ואם אני עושה הדפסה לPDF זה יוצא תקין.
אבל במחשבה שניה אני לא רוצה באקסס קוד של הדפסה לPDF כי אז הוא ירצה שאבחר מיקום קובץ לשמירה, וזה די בעייתי בשבילי.

ניסיתי במחשב לשנות את הברירת מחדל של קבצי PDF שלא יהיה אדובי אלא אדג', אבל זה לא עזר ועדיין הקובץ יצא משובש.
האם זה אומר שלא זו הבעיה, או שעדיין הוא יכול לגרום לשיבוש של הקובץ?

תודה!

@dovid תודה!

שלום וברכה.
יש לי טבלת אקסס עם שתי עמודות מסוג כן/לא. ואני רוצה למנוע אפשרות ששתי העמודות יהיו 'כן'.
איך אפשר לכתוב את זה? לכאו' זה נוסחה בכללי אימות של העמודות.
תודה!

@מלא כתב בקובץ PDF משובש בשמירה מVBA אקסס:

אם אתה מדפיס לPDF זה כן יוצא טוב?

איך כותבים את זה בקוד?
תודה.