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

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

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

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

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

    ערב טוב.
    לאחר עדכון ה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
    
    ש מלאמ 2 תגובות תגובה אחרונה
    8
    • א ארי

      ערב טוב.
      לאחר עדכון ה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
      
      ש מנותק
      ש מנותק
      שמעון חבצלת
      כתב ב נערך לאחרונה על ידי
      #2

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

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

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

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

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

        me.shekel = me.dollar * GetExchangeRates.sum
        
        ש תגובה 1 תגובה אחרונה
        0
        • א ארי

          ערב טוב.
          לאחר עדכון ה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
                                • דף הבית
                                • קטגוריות
                                • פוסטים אחרונים
                                • משתמשים
                                • חיפוש
                                • חוקי הפורום