Webden döviz bilgilerini alan kodda revize

[Korhan Ayhan]

Selamlar,

Arkadaşlar günlük döviz kurları ile ilgili bir çalışma yapmaktayım ve sitede araştırırken Sn. ALPEN 'e ait ekteki çalışmadaki kodları buldum biraz revize etmek istiyorum.

İlk olarak günlük kur sorgulamasında girilen tarih haftasonuna denk geliyorsa önceki işgününe ait bilgileri getirmesini istiyorum.

İkinci olarakta ay sorgulamasında ayın ilk günü haftasonuna denk geliyorsa önceki aya ait işgününün kurlarını getirmesini istiyorum.

Bunlarla ilgili birkaç deneme yaptım fakat başaramadım yardımlarınızı bekliyorum.

 

[Korhan Ayhan]

Arkadaşlar konuyla ilgili fikirlerinizi bekliyorum. :hey:

 

[veyselemre]

Fazla incelemedim ama şöyle bir deneyin.
[vb:1:14cb73c557]Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Set S1 = Sheets("VERİ")

S1.Visible = True
S1.Select
S1.[A1:F60].Clear

GÜN = Format(TextBox1, "00")
AY = Format(TextBox2, "00")
YIL = Format(TextBox3, "0000")

TARİH = DateSerial(YIL, AY, GÜN)
If Weekday(TARİH, vbMonday) = 6 Then TARİH = TARİH - 1
If Weekday(TARİH, vbMonday) = 7 Then TARİH = TARİH - 2

For X = 1 To 2
If Controls("TextBox" & X) = "" Then
MsgBox ("Günlük kur bilgilerini alabilmeniz için tarih girmelisiniz." _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "Dikkat !"
Controls("TextBox" & X).SetFocus
Exit Sub
End If
Next

On Error Resume Next

URL1 = "URL;http://www.tcmb.gov.tr/kurlar/" & Year(TARİH) & Format(Month(TARİH), "00") & "/" & Format(Day(TARİH), "00") & Format(Month(TARİH), "00") & Year(TARİH) & ".html"

With ActiveSheet.QueryTables.Add(Connection:=URL1, Destination:=Range("A1"))
.Name = TARİH
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

TextBox4 = Format(S1.Cells(7, 3) / 10000, "#,##0.0000 YTL")
TextBox5 = Format(S1.Cells(10, 3) / 10000, "#,##0.0000 YTL")

Label4 = "DURUM : " & TARİH & " Tarihli Kurlar Başarıyla Alındı..."
DoEvents
S1.Visible = False
S2.Select
Application.ScreenUpdating = True
End Sub[/vb:1:14cb73c557]

 

[Korhan Ayhan]

Selamlar,

Veysel bey verdiğiniz kod ile günlük sorgulamadaki problemim çözüldü fakat aylık kısmına uyarlayamadım kodları yardımcı olabilirmisiniz. :hey:

 

[veyselemre]

[vb:1:43fd3b474f]Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Set S1 = Sheets("VERİ")
Set S2 = Sheets("DOLAR")
Set S3 = Sheets("EURO")

S1.Visible = True
S1.Select
S1.[A1:F60].Clear
S2.[A4:E34].ClearContents
S3.[A4:E34].ClearContents

GÜN = Format(TextBox1, "00")
AY = Format(TextBox2, "00")
YIL = Format(TextBox3, "0000")

İLK = "01." & AY & "." & YIL
TEST = DateAdd("m", 1, İLK)
SON = DateAdd("d", -1, CDate(TEST))

If TextBox2 = "" Then
MsgBox ("Aylık kur bilgilerini alabilmeniz için tarih girmelisiniz." _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "Dikkat !"
TextBox2.SetFocus
Exit Sub
End If

On Error Resume Next

For X1 = İLK To SON

ee = Weekday(X1, vbMonday)

If ee > 5 Then
X = X1 - (ee - 5)
Else
X = X1
End If

URL1 = "URL;http://www.tcmb.gov.tr/kurlar/" & Year(X) & Format(Month(X), "00") & "/" & Format(Day(X), "00") & Format(Month(X), "00") & Year(X) & ".html"

With ActiveSheet.QueryTables.Add(Connection:=URL1, Destination:=Range("A1"))
.Name = X
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

SATIR = S2.[A35].End(3).Row + 1
S2.Cells(SATIR, 1) = X
S2.Cells(SATIR, 2) = S1.Cells(7, 3) / 10000
S2.Cells(SATIR, 3) = S1.Cells(7, 4) / 10000
S2.Cells(SATIR, 4) = S1.Cells(7, 5) / 10000
S2.Cells(SATIR, 5) = S1.Cells(7, 6) / 10000

SATIR = S3.[A35].End(3).Row + 1
S3.Cells(SATIR, 1) = X
S3.Cells(SATIR, 2) = S1.Cells(10, 3) / 10000
S3.Cells(SATIR, 3) = S1.Cells(10, 4) / 10000
S3.Cells(SATIR, 4) = S1.Cells(10, 5) / 10000
S3.Cells(SATIR, 5) = S1.Cells(10, 6) / 10000

Label4 = "DURUM : " & X & " Tarihli Kurlar Başarıyla Alındı..."
DoEvents
Next X1
S1.Visible = False
S2.Select
Application.ScreenUpdating = True
End Sub[/vb:1:43fd3b474f]

 

[Korhan Ayhan]

Selamlar,

Veysel bey yardımlarınız için teşekkür ederim aslında eklediğiniz kod kullanışlı fakat A sütununa yazılan tarihleri sıralı yazdırsak daha iyi olacak. Yada A sütunun yanına bir sütun daha ekleyip sorgulanan ayın günleri listelense daha güzel olacak gibi. :hey:

Ayrıca içinde bulunduğumuz ayı sorgularken ayın son gününe kadar değilde bulunduğumuz güne kadar sorgulamasını nasıl sağlarız.

 

[veyselemre]

A sütununa yazılan tarihleri sıralı yazdırsak daha iyi olacak.

[vb:1:7bf4b563d2]S2.Cells(SATIR, 1) = X1[/vb:1:7bf4b563d2] ve
[vb:1:7bf4b563d2]S3.Cells(SATIR, 1) = X1[/vb:1:7bf4b563d2]

Ayrıca içinde bulunduğumuz ayı sorgularken ayın son gününe kadar değilde bulunduğumuz güne kadar sorgulamasını nasıl sağlarız.

[vb:1:7bf4b563d2]For x1 = İLK To SON
If x1 >= Date Then Exit For[/vb:1:7bf4b563d2] ekleyin.

 

[Korhan Ayhan]

Selamlar,

Veysel bey size kocaman bir teşekkür gönderiyorum elinize sağlık... :hey:

 

[haruncelebi1]

sn.cost_control çalışmanızın son halini eklemeniz mümkün mü? teşekkürler.Syg

 

[Korhan Ayhan]

Selamlar,

1-2 gün içinde tamamlayıp ekleyeceğim. :hey:

 

[Korhan Ayhan]

Selamlar,

Arkadaşlar,

Üzerinde çalıştığım döviz kurları ile ilgili dosyayı tam bitirdim derken bir sorunla karşılaştım şöyleki;

Örneğin Ocak-2006 ayına ait kur bilgilerini sorgularken 09-01-2006 tarihine geldiğinde hata mesajı alıyorum bu hata mesajını internet bağlantısı olmayanları uyarmak amacıyla ben eklemiştim. Fakat belirttiğim tarih resmi tatile denk geldiği için hata mesajını alıyorum bu durumu nasıl düzeltebilirim. Aynı problemi 5. aydada yaşıyorum.

Not : İlk mesajımda eklemiş olduğum dosyayı güncelledim.

 

[Korhan Ayhan]

Selamlar,

Arkadaşlar bu konuda fikirlerinizi bekliyorum. :hey:

 

[Recep İpek]

Sayın COST_CONTROL,

Biraz basit olacak ama,
bir yere hafta sonu ve genel tatil günlerini girip buradan kontrol edebilirsiniz.

 

[Korhan Ayhan]

Selamlar,

Sn. ripek bunu bende düşündüm fakat yıl değişken olacağı için resmi tatil günleri listesi uzayacağı için farklı bir çözüm arıyorum.

 

[Recep İpek]

Sayın COST_CONTROL,

Başka bir öneri olarak makro hata verdiğinde;
"Seçtiğiniz gün hafta sonu veya genel tatile rastlamaktadır.Farklı bir tarih seçiniz." şeklinde uyarı verdirebilirsiniz.

 

[modalı]

Sayın ripek,

Access Bilgileri ve Örnekleri bölümüne dün bir uygulama ekledim. Orada dedikleriniz gerçekleşiyor.

iyi çalışmalar