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

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

💡 רוצה לזכור קריאת שמע בזמן? לחץ כאן!
  1. דף הבית
  2. תכנות
  3. שערים יציגים מבנק ישראל - VBA אקסס

שערים יציגים מבנק ישראל - VBA אקסס

מתוזמן נעוץ נעול הועבר תכנות
15 פוסטים 4 כותבים 437 צפיות 3 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • א ארי

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

    Option Compare Database
    Option Explicit
    
    Public Enum StrCurr
        USD = 1
        GBP = 2
        SEK = 3
        CHF = 4
        CAD = 5
        NZD = 6
        DKK = 7
        SGD = 8
        HKD = 9
        ZAR = 10
        AUD = 11
        EUR = 12
        JOD = 13
        NOK = 14
        JPY = 15
        RUB = 16
        PLN = 17
        MXN = 18
        CZK = 19
        TRY = 20
        LBP = 21
        EGP = 22
        HUF = 23
        INR = 24
        CNY = 25
    End Enum
    
    Public Type Rate
        Sum As Double
        CuDate As Date
    End Type
    
    Public Function test()
    Dim Rates As Rate
    
    Rates = GetExchangeRates
    
    With Rates
        Debug.Print .CuDate
        Debug.Print .Sum
    End With
    
    End Function
    
    Public Function GetExchangeRates(Optional Dtdate As Date, Optional StrCurr As StrCurr = USD) As Rate
    Dim str As String
    Dim Json As Object
    Dim item As Variant
    Dim element As Variant
    Dim CurrName As String
    Dim Sum As Double
        Dim i As String
    
    If Dtdate = "00:00:00" Then Dtdate = Date
    
    Select Case StrCurr
        Case 1: CurrName = "USD"
        Case 2: CurrName = "GBP"
        Case 3: CurrName = "SEK"
        Case 4: CurrName = "CHF"
        Case 5: CurrName = "CAD"
        Case 6: CurrName = "NZD"
        Case 7: CurrName = "DKK"
        Case 8: CurrName = "SGD"
        Case 9: CurrName = "HKD"
        Case 10: CurrName = "ZAR"
        Case 11: CurrName = "AUD"
        Case 12: CurrName = "EUR"
        Case 13: CurrName = "JOD"
        Case 14: CurrName = "NOK"
        Case 15: CurrName = "JPY"
        Case 16: CurrName = "RUB"
        Case 17: CurrName = "PLN"
        Case 18: CurrName = "MXN"
        Case 19: CurrName = "CZK"
        Case 20: CurrName = "TRY"
        Case 21: CurrName = "LBP"
        Case 22: CurrName = "EGP"
        Case 23: CurrName = "HUF"
        Case 24: CurrName = "INR"
        Case 25: CurrName = "CNY"
        Case Else: CurrName = ""
    End Select
    
    Select Case CurrName
        Case ""
            MsgBox "קוד מטבע לא חוקי!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
        Case Else
            
            str = "https://edge.boi.gov.il/FusionEdgeServer/sdmx/v2/data/dataflow/BOI.STATISTICS/EXR/1.0/RER_" & CurrName & "_ILS?startperiod=" & Format(Dtdate - 7, "YYYY-MM-DD") & "&endperiod=" & Format(Dtdate, "YYYY-MM-DD") & "&format=sdmx-json"
                    
            With CreateObject("MSXML2.ServerXMLHTTP.6.0")
                .Open "GET", str, False
                .send
                str = .responseText
            End With
    
            Set Json = JsonConverter.ParseJson(str)
            
            
            For Each item In Json("data")("dataSets")(1)("series")("0:0:0:0:0:0")("observations")
                GetExchangeRates.Sum = Json("data")("dataSets")(1)("series")("0:0:0:0:0:0")("observations")(item)(1)
            Next item
            
            For Each item In Json("data")("structure")("dimensions")("observation")(1)("values")
                GetExchangeRates.CuDate = item("name")
            Next item
        End Select
        
    End Function
    
    מלאמ מנותק
    מלאמ מנותק
    מלא
    כתב ב נערך לאחרונה על ידי
    #4

    @ארי כתב בשערים יציגים מבנק ישראל - VBA אקסס:

        MsgBox "÷åã îèáò ìà çå÷é!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
    
    א תגובה 1 תגובה אחרונה
    1
    • מלאמ מלא

      @ארי כתב בשערים יציגים מבנק ישראל - VBA אקסס:

          MsgBox "÷åã îèáò ìà çå÷é!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight
      
      א מנותק
      א מנותק
      ארי
      כתב ב נערך לאחרונה על ידי
      #5

      @מלא תוקן.
      תודה.

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

        @שמעון-חבצלת באירוע בעת לחיצה כפולה אתה שם

        me.shekel = me.dollar * GetExchangeRates.sum
        
        ש מנותק
        ש מנותק
        שמעון חבצלת
        כתב ב נערך לאחרונה על ידי
        #6

        @ארי תודה רבה על כל העזרה,
        אבל הקוד נתקע כאן:
        329c13e6-957c-4ace-84f6-49826ee1299c-image.png

        א תגובה 1 תגובה אחרונה
        0
        • ש שמעון חבצלת

          @ארי תודה רבה על כל העזרה,
          אבל הקוד נתקע כאן:
          329c13e6-957c-4ace-84f6-49826ee1299c-image.png

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

          @שמעון-חבצלת סליחה, שכחתי לציין שצריך קוד שממיר Json לאקסס.
          תוסיף את הקוד שיש בקובץ המצורף לVBA שלך (בתוך חלון הVBA בצד ימין איפה שכל המודולים, לחיצה על המקש הימני בעכבר ועל ייבוא מקובץ).

          JsonConverter.bas

          ש תגובה 1 תגובה אחרונה
          2
          • א ארי

            @שמעון-חבצלת סליחה, שכחתי לציין שצריך קוד שממיר Json לאקסס.
            תוסיף את הקוד שיש בקובץ המצורף לVBA שלך (בתוך חלון הVBA בצד ימין איפה שכל המודולים, לחיצה על המקש הימני בעכבר ועל ייבוא מקובץ).

            JsonConverter.bas

            ש מנותק
            ש מנותק
            שמעון חבצלת
            כתב ב נערך לאחרונה על ידי
            #8

            @ארי תודה על הכל
            א. עכשיו הוא מקפיץ לי את החלון הזה
            5ddc1111-c8e1-4688-9f99-ec6f605497b0-image.png
            ב. האם יש אפשרות שזה יעבוד גם אופליין ויזכור את הפעם האחרונה?

            א תגובה 1 תגובה אחרונה
            0
            • ש שמעון חבצלת

              @ארי תודה על הכל
              א. עכשיו הוא מקפיץ לי את החלון הזה
              5ddc1111-c8e1-4688-9f99-ec6f605497b0-image.png
              ב. האם יש אפשרות שזה יעבוד גם אופליין ויזכור את הפעם האחרונה?

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

              @שמעון-חבצלת א. אתה צריך להוסיף לreferences את Microsoft scripting runtime.
              ב. אתה יכול ליצור טבלה ובה לשמור את הערך האחרון שמתקבל בכל קריאה.

              ש תגובה 1 תגובה אחרונה
              2
              • א ארי

                @שמעון-חבצלת א. אתה צריך להוסיף לreferences את Microsoft scripting runtime.
                ב. אתה יכול ליצור טבלה ובה לשמור את הערך האחרון שמתקבל בכל קריאה.

                ש מנותק
                ש מנותק
                שמעון חבצלת
                כתב ב נערך לאחרונה על ידי
                #10

                @ארי א. לא הבנתי מה אתה אומר... סליחה שאני ככה משגע אותך אבל אני לא ממש מבין בקודים.
                ב. לשמור בטבלה אני יודע השאלה איך אני מגדיר שכאשר אין אינטרנט הוא לוקח משם. (לא אכפת לי שיקח תמיד מהטבלא ופעם ביום זה יעדכן)...
                תודה ארי

                תגובה 1 תגובה אחרונה
                0
                • איש ימיניא מנותק
                  איש ימיניא מנותק
                  איש ימיני
                  כתב ב נערך לאחרונה על ידי איש ימיני
                  #11

                  @ארי הקישור של בנק ישראל הפסיק לעבוד.
                  הקוד לא עובד.
                  יש למישהו מושג מה הקישור המעודכן?

                  image.png

                  תגובה 1 תגובה אחרונה
                  0
                  • איש ימיניא מנותק
                    איש ימיניא מנותק
                    איש ימיני
                    כתב ב נערך לאחרונה על ידי
                    #12

                    שיניתי את הקוד עבור שער יציג של הדולר:
                    (עבורי זה מספיק)

                    Option Compare Database
                    Option Explicit
                     
                    Public Function GetExchangeRatesUSD()
                    Dim str As String
                    Dim Json As Object
                    
                            str = "https://boi.org.il/PublicApi/GetExchangeRate?key=USD"
                                 
                            With CreateObject("MSXML2.ServerXMLHTTP.6.0")
                                .Open "GET", str, False
                                .send
                                str = .responseText
                            End With
                     
                            Set Json = JsonConverter.ParseJson(str)
                            GetExchangeRatesUSD = Json("currentExchangeRate")
                    End Function
                    
                    א תגובה 1 תגובה אחרונה
                    1
                    • איש ימיניא איש ימיני

                      שיניתי את הקוד עבור שער יציג של הדולר:
                      (עבורי זה מספיק)

                      Option Compare Database
                      Option Explicit
                       
                      Public Function GetExchangeRatesUSD()
                      Dim str As String
                      Dim Json As Object
                      
                              str = "https://boi.org.il/PublicApi/GetExchangeRate?key=USD"
                                   
                              With CreateObject("MSXML2.ServerXMLHTTP.6.0")
                                  .Open "GET", str, False
                                  .send
                                  str = .responseText
                              End With
                       
                              Set Json = JsonConverter.ParseJson(str)
                              GetExchangeRatesUSD = Json("currentExchangeRate")
                      End Function
                      
                      א מנותק
                      א מנותק
                      ארי
                      כתב ב נערך לאחרונה על ידי
                      #13

                      @איש-ימיני איזה קישור לא עבד לך?
                      לי הקוד עבד מצוין. וגם הקישור הזה עבד.

                      תגובה 1 תגובה אחרונה
                      0
                      • איש ימיניא מנותק
                        איש ימיניא מנותק
                        איש ימיני
                        כתב ב נערך לאחרונה על ידי
                        #14

                        הקישור הזה לא עבד.
                        זה החזיר שגיאה.
                        אני רואה שעכשיו כן עובד.
                        מוזר.

                        א תגובה 1 תגובה אחרונה
                        0
                        • איש ימיניא איש ימיני

                          הקישור הזה לא עבד.
                          זה החזיר שגיאה.
                          אני רואה שעכשיו כן עובד.
                          מוזר.

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

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

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


                          בא תתחבר לדף היומי!
                          • התחברות

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

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