Public SelectedDate As String, DefaultDate As StringPublic dt_1 As Date, dt_2 As Date
Option Explicit
Sub GetRates()


Dim sURL As String
Dim objHttp As Object
Dim sHtmlCode As String
Dim varInpDate As Variant
Dim WshShell As Object
Dim RegValue As String
Dim sDay As String, sMonth As String, sYear As String
Dim sDollarRate As String, sEuroRate As String, sYuanRate As String, sPoundRate As String
    'varInpDate = InputBox("Введите дату в формате ДД.ММ.ГГГГ", "Курсы валют", Date)
    Form_SelectDate.Show
    varInpDate = CStr(SelectedDate)
    If varInpDate = "" Then Exit Sub
    varInpDate = CDate(varInpDate)
    sDay = Format(varInpDate, "dd")
    sMonth = Format(varInpDate, "mm")
    sYear = Format(varInpDate, "yyyy")
    sURL = "http://www.nationalbank.kz/rss/get_rates.cfm?fdate=" & _
            sDay & "." & sMonth & "." & sYear & "&switch=kazakh"
    On Error Resume Next
    Set objHttp = CreateObject("MSXML2.XMLHTTP.3.0")
    If Err.Number <> 0 Then
        Err.Clear
        Set objHttp = CreateObject("MSXML2.XMLHTTP")
        If Err.Number <> 0 Then
            Set objHttp = CreateObject("MSXML.XMLHTTPRequest")
        End If
    End If
    If objHttp Is Nothing Then
        MsgBox "Невозможно создать объект для подключения к интернет!", 48, "Ошибка"
        Exit Sub
    End If
    If objHttp Is Nothing Then Exit Sub
    objHttp.Open "GET", sURL, False
    On Error Resume Next
    objHttp.Send
    If Err.Number <> 0 Then
        MsgBox "Отсутствует доступ в интернет!", 48, "Ошибка"
        Exit Sub
    End If
    On Error GoTo 0
    sHtmlCode = objHttp.responseText
    Set objHttp = Nothing
    On Error Resume Next
    sDollarRate = Mid(sHtmlCode, InStr(InStr(1, sHtmlCode, "USD"), sHtmlCode, "</td></tr>") - 7, 7)
    sEuroRate = Mid(sHtmlCode, InStr(InStr(1, sHtmlCode, "EUR"), sHtmlCode, "</td></tr>") - 7, 7)
    sHtmlCode = ""
    '-------------------------------------------------------------------------------
    'считываем значение ключа реестра
    'HKEY_CURRENT_USER\Control Panel\International\\sMonDecimalSep
    'чтобы узнать какой знак является разделителем целой и дробной части
    'указанной в Панель управления - Язык и региональные стандарты -
    'Настройка - Денежная единица - Разделитель целой и дробной части
    Set WshShell = CreateObject("WScript.Shell")
    RegValue = WshShell.RegRead("HKEY_CURRENT_USER\Control Panel\International\\sMonDecimalSep")
    If RegValue = "." Then
        sDollarRate = CSng(Replace(sDollarRate, ",", "."))
        sEuroRate = CSng(Replace(sEuroRate, ",", "."))
    End If
    '-------------------------------------------------------------------------------
    Application.ScreenUpdating = False
    [DollarRng] = ""
    [EuroRng] = ""
    [DateRng] = varInpDate
    [DollarRng] = Replace(sDollarRate, ",", ".")
    [EuroRng] = Replace(sEuroRate, ",", ".")
    ActiveSheet.Hyperlinks.Add Anchor:=Range("LinkRng"), Address:=sURL, _
            ScreenTip:="Перейти на сайт НБ РК", TextToDisplay:="НБ РК"
    Application.ScreenUpdating = True
    MsgBox Format(varInpDate, "DD MMMM YYYY") & Chr(13) & Chr(13) _
            & "Доллар: " & vbTab & sDollarRate & Chr(13) & "Евро: " & vbTab & sEuroRate & Chr(13) _
            & "Отношение: " & Format(sEuroRate / sDollarRate, "0.0000"), 64, "Курсы валют"
End Sub