שערים יציגים מבנק ישראל - VBA אקסס
-
ערב טוב.
לאחר עדכון ה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@ארי אני לא מספיק מבין בקוד הזה. רציתי לדעת באיזה פונקציה אני משתמש כדי להמיר את הסכום הקיים לשער של דולר, ואיל לכתוב אותה.
יש לי תוכנה עם סכומים אני רוצה שבעת לחיצה כפולה על הסכום הוא יכפיל את הסכום בשער הדולר.
איך לכתוב את הקוד? באיזה פונקציה להשתמש ואיך אפשר להשתמש איתה בשביל מה שאני צריך?
(את הקוד עצמו זרקתי במודל 1)
תודה רבה!!! -
@ארי אני לא מספיק מבין בקוד הזה. רציתי לדעת באיזה פונקציה אני משתמש כדי להמיר את הסכום הקיים לשער של דולר, ואיל לכתוב אותה.
יש לי תוכנה עם סכומים אני רוצה שבעת לחיצה כפולה על הסכום הוא יכפיל את הסכום בשער הדולר.
איך לכתוב את הקוד? באיזה פונקציה להשתמש ואיך אפשר להשתמש איתה בשביל מה שאני צריך?
(את הקוד עצמו זרקתי במודל 1)
תודה רבה!!!@שמעון-חבצלת באירוע בעת לחיצה כפולה אתה שם
me.shekel = me.dollar * GetExchangeRates.sum -
ערב טוב.
לאחר עדכון ה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 -
@ארי כתב בשערים יציגים מבנק ישראל - VBA אקסס:
MsgBox "÷åã îèáò ìà çå÷é!", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight -
@שמעון-חבצלת באירוע בעת לחיצה כפולה אתה שם
me.shekel = me.dollar * GetExchangeRates.sum@ארי תודה רבה על כל העזרה,
אבל הקוד נתקע כאן:
-
@ארי תודה רבה על כל העזרה,
אבל הקוד נתקע כאן:
@שמעון-חבצלת סליחה, שכחתי לציין שצריך קוד שממיר Json לאקסס.
תוסיף את הקוד שיש בקובץ המצורף לVBA שלך (בתוך חלון הVBA בצד ימין איפה שכל המודולים, לחיצה על המקש הימני בעכבר ועל ייבוא מקובץ). -
@שמעון-חבצלת סליחה, שכחתי לציין שצריך קוד שממיר Json לאקסס.
תוסיף את הקוד שיש בקובץ המצורף לVBA שלך (בתוך חלון הVBA בצד ימין איפה שכל המודולים, לחיצה על המקש הימני בעכבר ועל ייבוא מקובץ).@ארי תודה על הכל
א. עכשיו הוא מקפיץ לי את החלון הזה
ב. האם יש אפשרות שזה יעבוד גם אופליין ויזכור את הפעם האחרונה? -
@ארי תודה על הכל
א. עכשיו הוא מקפיץ לי את החלון הזה
ב. האם יש אפשרות שזה יעבוד גם אופליין ויזכור את הפעם האחרונה?@שמעון-חבצלת א. אתה צריך להוסיף לreferences את Microsoft scripting runtime.
ב. אתה יכול ליצור טבלה ובה לשמור את הערך האחרון שמתקבל בכל קריאה. -
@שמעון-חבצלת א. אתה צריך להוסיף לreferences את Microsoft scripting runtime.
ב. אתה יכול ליצור טבלה ובה לשמור את הערך האחרון שמתקבל בכל קריאה.@ארי א. לא הבנתי מה אתה אומר... סליחה שאני ככה משגע אותך אבל אני לא ממש מבין בקודים.
ב. לשמור בטבלה אני יודע השאלה איך אני מגדיר שכאשר אין אינטרנט הוא לוקח משם. (לא אכפת לי שיקח תמיד מהטבלא ופעם ביום זה יעדכן)...
תודה ארי -
שיניתי את הקוד עבור שער יציג של הדולר:
(עבורי זה מספיק)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 -
שיניתי את הקוד עבור שער יציג של הדולר:
(עבורי זה מספיק)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 -
@איש-ימיני מוזר.
אולי יש עבודות תחזוקה או משהו כזה.
