- Katılım
- 6 Eylül 2007
- Mesajlar
- 657
- Excel Vers. ve Dili
- excel 2016 32 Bit ve Excel 2020 32 Bit Türkçe ve İngilizce
Arkadaşlar yukarıdaki hata mesajını devamlı almaya başladım. Modül 102 kodları aşağıdaki gibidir, nerde bir hata var?
Option Explicit
Dim say
Dim ekle1
Enum xKurTip
xForexBuying = 0
xForexSelling = 1
xBanknoteBuying = 2
xBanknoteSelling = 3
End Enum
Sub saydırma()
On Error Resume Next
Dim objRange As Range
Set objRange = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
If Not objRange Is Nothing Then
ekle1 = 100 / CStr(objRange.Cells.Count)
Else
ekle1 = 2
End If
Set objRange = Nothing
say = 0
End Sub
Function KurSorgula(xKurKod As String, Optional xTarih As Date, Optional KurTipi As xKurTip = xForexBuying) As Double
say = say + ekle1
If say > 100 Then say = 100
UserForm70.Label2.Caption = WorksheetFunction.Round((say), 2) * 1
UserForm70.ProgressBar1.Value = say
Const xmlURL1 = "https://tcmb.gov.tr/kurlar/today.xml"
Const xmlURL2 = "https://www.tcmb.gov.tr/kurlar/%p1/%p2.xml"
Dim xmlTCMB
Dim xmlNODE
Dim xmlURL As String
Dim Sor
If IsEmpty(xTarih) Or xTarih = #12:00:00 AM# Then
xTarih = Date
End If
If xTarih >= Date Then
xmlURL = xmlURL1
Else
xmlURL = Replace(Replace(xmlURL2, "%p1", Format(xTarih - 1, "yyyymm")), "%p2", Format(xTarih - 1, "ddmmyyyy"))
End If
Do Until XMLVarmi(xmlURL)
If xmlURL <> xmlURL1 Then
xTarih = xTarih - 1
If xTarih < #6/18/2002# Then GoTo Hata
xmlURL = Replace(Replace(xmlURL2, "%p1", Format(xTarih, "yyyymm")), "%p2", Format(xTarih, "ddmmyyyy"))
Else
GoTo Hata
End If
DoEvents
Loop
Set xmlTCMB = CreateObject("MSXML2.DOMDocument.6.0")
xmlTCMB.Load xmlURL
Do
DoEvents
Loop Until xmlTCMB.parsed = True
Set xmlNODE = xmlTCMB.SelectNodes("Tarih_Date/Currency[@Kod='" & xKurKod & "'][BanknoteBuying>0]")
Select Case KurTipi
Case xForexBuying
KurSorgula = Val(xmlNODE.Item(0).SelectNodes("ForexBuying").Item(0).Text) ', ".", Application.DecimalSeparator))
Case xForexSelling
KurSorgula = Val(xmlNODE.Item(0).SelectNodes("ForexSelling").Item(0).Text) ', ".", Application.DecimalSeparator))
Case xBanknoteBuying
KurSorgula = Val(xmlNODE.Item(0).SelectNodes("BanknoteBuying").Item(0).Text) ', ".", Application.DecimalSeparator))
Case xBanknoteSelling
KurSorgula = Val(xmlNODE.Item(0).SelectNodes("BanknoteSelling").Item(0).Text) ', ".", Application.DecimalSeparator))
End Select
Set xmlTCMB = Nothing
Set xmlNODE = Nothing
Exit Function
Hata:
Set xmlTCMB = Nothing
Set xmlNODE = Nothing
KurSorgula = "Yok"
End Function
Private Function XMLVarmi(URL As String) As Boolean
Dim HTTPBaglanti As Object
Set HTTPBaglanti = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error GoTo XMLVarmi_Error
HTTPBaglanti.Open "GET", URL
HTTPBaglanti.send
If HTTPBaglanti.Status = 200 Then
XMLVarmi = True
Else
XMLVarmi = False
End If
Set HTTPBaglanti = Nothing
Exit Function
XMLVarmi_Error:
Set HTTPBaglanti = Nothing
XMLVarmi = False
End Function
