İmsakiye

[halit3]

İmsakiye
Webten bilgi sorgulama başlığı altında benzer bir dosya vardı ama kullanıcı aktif olmadığında o bölüm gözükmediğinden bu bölüme de konu açtım hayırlı olsun.

İmsakiye (Namaz Vakitleri) webten sorgulama çalışması ayrıca namaz vakitleri ile ilgili userform çalışmasında da beş vakit ezan ukumaktadır.

not: rar dosyalarını indirin ve dosyalarım hepsini bir klasörün içine koyun.

uyarı :
dosyanın çalışması için Timer.ocx dosyası ve ietimer.ocx dosyaları bilgisayarınızda yüklü olması gerekiyor bu dosyaların nasıl yükleneceğine dair örnek görsel dosyada mevcut.

ayrıca dll dosyalarını yüklemek için exe dosyası hazırlandı


görsel video

02.07.2014 tarih 10:06 saat de güncellendi

 

[halit3]

Mesaj düzenlendi

 

[halit3]

1 nolu mesajdaki dosya güncellendi

Dosyada saat ve dakika farkı ilave edildi

 

[Mukteda]

Halit Bey,

Malum mevsimdeyiz. 11 ayın sultanını karşılamak için yollara döküldük.

Bizim gibi altın üye olmayanlar için harici upload etme imkanınız var mıdır?

 

[halit3]

Halit Bey,

Malum mevsimdeyiz. 11 ayın sultanını karşılamak için yollara döküldük.

Bizim gibi altın üye olmayanlar için harici upload etme imkanınız var mıdır?

Merhaba ben farklı sitelere dosya yüklemiyorum
Bu kod işinizi görecektir kırmızı yerlere il ve ilçe bölümüne verileri yazın kodu çalıştırın.

Sub deneme1_Click()
'On Error Resume Next
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")

Cells.Interior.ColorIndex = xlNone
Cells.ClearContents
sat = 1
With ie
ie.Visible = 1
.Visible = 1
.Width = 50
.Height = 50
.Left = 20
.Top = 0

ie.Navigate "http://ramazan.diyanet.gov.tr/tr-TR/Imsakiye"

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
ie.Visible = 1

For k = 1 To ie.document.All("ulkeId").Length - 1
If ie.document.All.ulkeId(k).Text = "Türkiye" Then
ie.document.All("ulkeId").Focus
ie.document.All("ulkeId").selectedindex = k
ie.document.All("ulkeId").onchange

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Exit For
End If
Next k

Application.Wait (Now + TimeValue("0:00:01"))

For t = 1 To ie.document.All("ilId").Length - 1
If ie.document.All.ilId(t).Text = "ADANA" Then
ie.document.All("ilId").Focus
ie.document.All("ilId").selectedindex = t
ie.document.All("ilId").onchange

Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Exit For
End If
Next t


For n = 1 To ie.document.All("ilceId").Length - 1
If ie.document.All.ilceId(n).Text = "CEYHAN" Then
ie.document.All("ilceId").Focus
ie.document.All("ilceId").selectedindex = n
ie.document.All("ilceId").onchange
Do Until ie.ReadyState = 4: DoEvents: Loop
Do While ie.Busy: DoEvents: Loop
Exit For
End If
Next n

Application.Wait (Now + TimeValue("0:00:01"))

Set tbl = ie.document.getElementsByTagName("table").Item(0)
For i = 1 To tbl.Rows.Length - 1
veri = WorksheetFunction.Trim(Replace(Replace(Replace(tbl.Rows(i).Cells(0).InnerText, Chr(13), "  "), Chr(10), "  "), ",", ""))
If Left(veri, 5) = "KADİR" Then Cells(sat - 1, 9) = "Kadir Gecesi": GoTo atla
For j = 0 To tbl.Rows(i).Cells.Length - 1
Cells(sat, j + 1) = WorksheetFunction.Trim(tbl.Rows(i).Cells(j).InnerText)
Cells(sat, j + 1).WrapText = False
Next

sat = sat + 1
atla:
Next
ie.Quit: Set ie = Nothing
End With

MsgBox "işlem tamam"
End Sub

NOT:internetin geçmiş Tarama bölümlerini temizlenmesi gerekiyor

 

[Mukteda]

Halit Bey merhaba,

Tamamdır. İlginiz ve yardımınız için çok teşekkür ederim.

Sağlıcakla kalın.