- Katılım
- 6 Eylül 2007
- Mesajlar
- 655
- Excel Vers. ve Dili
- excel 2016 32 Bit ve Excel 2020 32 Bit Türkçe ve İngilizce
- Altın Üyelik Bitiş Tarihi
- 10-12-2024
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
