• Foruma hoş geldin 👋 Ziyaretçi

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak tamamen ücretsizdir.

Çözüldü Web den sahur iftar saatlerini otomatik alma yapılır mı?

Bu konu çözüldü olarak işaretlenmiştir. Çözülmediğini düşünüyorsanız konuyu rapor edebilirsiniz.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.

Excelismail

Yeni Üye
Katılım
22 Mar 2022
Mesajlar
170
Çözümler
2
Aldığı beğeni
57
Excel V
Office 365 TR
Hayırlı Ramazanlar, hayırlı günler.

Ekte eklediğimi Tüm illerin excel ramazan 2022 imsakiyesine ve inşallah gelecek seneler de dahil olmak üzere illerin sahur ve iftar vakitlerini otomatik olarak eklenebilir mi?

Eğer olursa; İmsak ve iftar bilgileri Din İşleri Yüksek Kurulu : Dini Bilgilendirme Platformu siteden gelecek. Çalışma sayfası Vakitler sayfası; A sütüne iller, B sütün tarih, C sütun sahur ve D sütun iftar olarak gelsin.
 

Ekli dosyalar

Merhaba.

Uzun uğraşlar sonucu alttaki gibi bir kod yapabildim.
Kod bilginiz varsa sanıyorum bu koda eklemeler yapıp ayarlayabiliriz.

ilgili siteden 504 ve 9193 gibi olanları buldum biri il diğeri ilçe.
Hepsini alıp güzel bir şekilde yaparsam paylaşırım dosyayı.
Ben fazla anlamıyorum internetten veri çekme ama araştırınca buldum bişeyler :)

Rich (BB code):
Sub test()

 With CreateObject("InternetExplorer.Application")
        .Visible = True
        .navigate "https://kurul.diyanet.gov.tr/Sayfalar/Imsakiye.aspx"
      
        Do While .Busy Or .ReadyState <> 4
            DoEvents
        Loop

        With .document
            Set chng = .createEvent("HTMLEvents")
            chng.initEvent "change", True, False

            Set sehir = .getElementById("cphMainSlider_solIcerik_ddlSehirler")
            sehir.Value = "504" 'Aksaray
            sehir.dispatchEvent chng
            
            Application.Wait (Now + TimeValue("0:00:03"))
            Set ilce = .getElementById("cphMainSlider_solIcerik_ddlIlceler")
            ilce.Value = "9193" 'Aksaray
            ilce.dispatchEvent chng
        End With
    End With
End Sub
 
Yani bu kodlar çalışınca il ve ilçe değişiyor ilgili sitede.
Artık ordanda verileri sayfaya çekmek sanıyorum zor değil.
Sadece 81 ilin ilgili numaraları ve ilçenin numaralarını tek tek almam gerekecek o siteden incele yolu ile.
Gerisi kolay sanki.
Dediğim gibi bitince eklerim.
 

Refaz,​


Öncelikle hayırlı Ramazanlar. Yardım için teşekkürler, eyvallah.

Hocam, Refaz; sayfada bir buton olsa bu butona tıklasak tüm internetteki verileri çekse... Kod bilgim yok ekteki dosyayı hazırlarsanız paylaşırsanız sevinirim... Müteşekkir olurum.
 
Sizede hayırlı ramazanlar abey.
Comboboxtan seçilince yada butona tıklayınca ilgili siteye örnek adana gönderip orda adananın imsakiyeleri getirilir.Ama sonradan o verileri nasıl excele getireceğim kara kara düşünmekteyim :)
Keşke fazla anlasaydım ama umudum biraz azaldı :(
Yinede bişeyley yapınca eklerim.
İnternet adresinin sonuna il ve ilçeleri birleştirme olsaydı iş kolaydı ama vardır bir yolu.
 
Bir kere başlamış oldum bu konuya.
Bu yüzden dasyayı bitirdim.

Array(500, 9146) buraki 500 İL,9146 ise oluyor.Bunları sayfayı incele yaparak bulabilirsiniz.
Ben sadece Adana,Adıyaman ve Ankara için yaptım.
Kod çalışınca sendkeys den dolayı numlock kapanıyor bunun için internette çözüm var ve bu dosyayı kullanmaya gerek duyulmadığını düşündüğüm için eklemedim koda.
Kod çalışırken başka işlem yapmayın.
Çünkü giftede gösterdiğim gibi tarayıcı açılıyor veriler oraya gidince sayfadakileri kopyalıyor ve excele alıyor.
Tarayıcı çalışırken görünür olmalı.Aktarım adında sayfa ekledim silinmemesi gerekiyor kopyalanan veriler oraya gidiyor önce.

Eminim başka yolda vardır ama anlamıyorum veri çekme internetten.

reee.gif

Rich (BB code):
'Tarayici görünür olsun diye eklendi Api
#If VBA7 Then
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
      ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
      ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

#Else
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
      ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
      ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If

Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2

Function getirSayi_iL_ilce(ByVal cbo As Object)
    Select Case cbo.Value
        Case "Adana": getirSayi_iL_ilce = Array(500, 9146)
        Case "Adýyaman": getirSayi_iL_ilce = Array(501, 9158)
        Case "Ankara": getirSayi_iL_ilce = Array(506, 9206)
        Case Else: getirSayi_iL_ilce = Array(0, 0)
    End Select
End Function


Private Sub CbxSehir_Change()

    If Trim(Me.CbxSehir.Value) = "" Then
        MsgBox "Sehir sec", vbCritical, "hata": Exit Sub
    End If
  
    If getirSayi_iL_ilce(Me.CbxSehir)(0) = 0 Then
            MsgBox "Sehir bulunamadi", vbCritical, "hata": Exit Sub
    End If
           Set ie = CreateObject("internetexplorer.application")
With ie

    ie.Visible = True
    SetWindowPos ie.hwnd, 0, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
        .Visible = True
        .navigate "https://kurul.diyanet.gov.tr/Sayfalar/Imsakiye.aspx"
     
        Do While .busy Or .readystate <> 4
            DoEvents
        Loop

        With .document
            Set chng = .createEvent("HTMLEvents")
            chng.initEvent "change", True, False

            Set sehir = .getelementbyid("cphMainSlider_solIcerik_ddlSehirler")
            sehir.Value = getirSayi_iL_ilce(Me.CbxSehir)(0)
            sehir.dispatchEvent chng

            Application.Wait (Now + TimeValue("0:00:03"))
            Set ilce = .getelementbyid("cphMainSlider_solIcerik_ddlIlceler")
            ilce.Value = getirSayi_iL_ilce(Me.CbxSehir)(1)
            ilce.dispatchEvent chng
          
            Application.Wait (Now + TimeValue("0:00:02"))
            Application.SendKeys "^a"
            Application.Wait (Now + TimeValue("0:00:02"))
            Application.SendKeys "^c"

        End With
             .Quit

'Application.ScreenUpdating = False
             With ThisWorkbook.Worksheets("Aktarim")
                .Activate
                .Cells.Clear
                .Range("A1").Activate
                .PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
                Sayfa2.Activate 'imsakiye sayfasi
              
                Dim bul As Range, i As Byte, say As Byte
                Set bul = .Range("A:A").Find("Hicri Tarih", , , 1)
                say = 2
                Sayfa2.Range("A2:A5,D2:D50,E2:E50").ClearContents
                If Not bul Is Nothing Then
                    For i = 1 To 32
                        If .Cells(bul.Row + i, 1).Value <> "Kadir Gecesi" Then
                            Sayfa2.Range("A" & say).Value = .Range("B" & bul.Row + i).Value
                            Sayfa2.Range("D" & say).Value = .Range("C" & bul.Row + i).Value
                            Sayfa2.Range("E" & say).Value = .Range("G" & bul.Row + i).Value
                            say = say + 1
                         End If
                    Next
                End If
                .Cells.Clear
'Application.ScreenUpdating = True
             End With
    End With
    MsgBox Me.CbxSehir & " iline ait imsakiye getirildi", vbInformation, "Bilgi"
    LblNamaz.Caption = Format(Sayfa3.Range("C4").Value, "hh:MM")
End Sub
 

Ekli dosyalar

Son düzenleme:

Refaz,​

Tekrarda sağ olasın. Çok uğraş emek vermişsin. Eyvallah.

Aşağıdaki kodlarda illerdeki rakamlara artıkça mı iller geliyor, bütün iş bura da yani illeri getiriyoruz?

Function getirSayi_iL_ilce(ByVal cbo As Object)
Select Case cbo.Value
Case "Adana": getirSayi_iL_ilce = Array(500, 9146)
Case "Adıyaman": getirSayi_iL_ilce = Array(501, 9158)
Case "Ankara": getirSayi_iL_ilce = Array(506, 9206)
Case Else: getirSayi_iL_ilce = Array(0, 0)
End Select
End Function
 
Bişey değil abey.
Evet case Ankara nın altına devam edilecek ve İl ve numaralar doğru yazılmalı.
Zaman buldukça uğraşırım belki explorer gösterilmeyebilinir ve ek sayfaya gerek olmayabilinir.
 
Abey siz dediklerimi tamamlayın inşAllah güzel olacak biraz ilerleme var bende.
Bayram namazlarını vs... ve İL adlarınıda otomatik çekebiliriz.
Yavaş yavaş ilerleme oluyor.
 
Abey.
Bugün biter dosya kopyalama,numlock ve extra sayfalara gerek kalmadı.
Gerekli ayarlamaları yapınca dosyayı eklerim.
 
Abey dosya bitti.
Adıyaman,Ankara ve Adana için yaptım.

Sabitler sayfasındaki bayram namazları saatlarine gerek yok onu ve bazı işlemleri ayarlarım bu akşam.
Gif ekledim.
Extra sayfaya nasıl veri geliyor diye tek tek veri aldırdım onuda değiştiririz sonra.
Deneye yanıla araştıra araştıra bu hale geldi.
Dediğim gibi akşam tam ilgilenirim.

Forumda o kadar internetten veri çekme anlayan var neden el atmıyorlar buda ayrı bir konu :)

rrr.gif



Rich (BB code):
Function getirSayi_iL_ilce(ByVal cbo As Object)
    Select Case cbo.Value
        Case "Adana": getirSayi_iL_ilce = Array(500, 9146)
        Case "Adıyaman": getirSayi_iL_ilce = Array(501, 9158)
        Case "Ankara": getirSayi_iL_ilce = Array(506, 9206)
        Case Else: getirSayi_iL_ilce = Array(0, 0)
    End Select
End Function

Private Sub CbxSehir_Change()
    Dim row As Long, j As Integer, son As Integer, x As Byte


    If Trim(Me.CbxSehir.Value) = "" Then
        MsgBox "Sehir sec", vbCritical, "hata": Exit Sub
    End If
    
     On Error GoTo hata
    
    If getirSayi_iL_ilce(Me.CbxSehir)(0) = 0 Then
            MsgBox "Sehir bulunamadi", vbCritical, "hata": Exit Sub
    End If
    
 With CreateObject("internetexplorer.application")
        .Visible = False
        .navigate "https://kurul.diyanet.gov.tr/Sayfalar/Imsakiye.aspx"
      
        Do While .busy Or .readyState <> 4
            DoEvents
        Loop


        With .document
            Set chng = .createEvent("HTMLEvents")
            chng.initEvent "change", True, False


            Set sehir = .getElementById("cphMainSlider_solIcerik_ddlSehirler")
            sehir.Value = getirSayi_iL_ilce(Me.CbxSehir)(0)
            sehir.dispatchEvent chng
                      
            Application.Wait (Now + TimeValue("0:00:03"))
            Set ilce = .getElementById("cphMainSlider_solIcerik_ddlIlceler")
            ilce.Value = getirSayi_iL_ilce(Me.CbxSehir)(1)
            ilce.dispatchEvent chng
            
            ReDim arr(1 To 10000, 1 To 8)
            
           Application.Wait (Now + TimeValue("0:00:03"))
            row = 1
            For Each t In .getElementsByclassName("table")
                If t.className = "table  table-bordered table table-hover" Then
                    For Each tr In t.getElementsByTagName("TR")
                        j = 1
                        For Each td In tr.getElementsByTagName("TD")
                             arr(row, j) = td.innerText
                            j = j + 1
                        Next
                        row = row + 1
                    Next
                    row = row + 3
                End If
            Next
            With Sayfa2
                .Range("A2:A50,D2:D50,E2:E50").ClearContents
                For x = 2 To 35
                    son = .Cells(Rows.Count, 1).End(3).row + 1
                    .Cells(son, 1).Value = arr(x, 2)
                    .Cells(son, 4).Value = arr(x, 3)
                    .Cells(son, 5).Value = arr(x, 7)
                Next x
            End With
            
        End With
        .Quit
    End With
    MsgBox Me.CbxSehir & " iline ait imsakiye getirildi", vbInformation, "Bilgi"
    LblNamaz.Caption = Format(Sayfa3.Range("C4").Value, "hh:MM")
    Exit Sub
hata:
    MsgBox "Hata olustu tekrar dene..", vbCritical, "Hata"
End Sub
 

Ekli dosyalar

Sahurdan sonra illere 12 şer 12 şer değer verdim ama Aksaray’da kaldı. İl adını yazsamda hep Aksaray geldi.
 
Kodlar çalışıyor function kodunu ekleyin bakıp onuda koda ekleyelim.
Normalde mantıken o sitedeki kaynak kodlarındanda numara çekilebilinir ama tecrübesiz olduğum için bukadar oldu zaman olunca onuda otomatiğe bağlatırız belki.
 

Refaz,​

hocam Afyonkarahisar getirdim. sanırım oldu. Ama biraz bekleyince geliyor. Bir ekran resmi ekleyeyim.
 

Ekli dosyalar

  • Afyon.png
    Afyon.png
    93.8 KB · Gösterim: 6

Refaz,​

hocam Afyonkarahisar getirdim. sanırım oldu. Ama biraz bekleyince geliyor. Bir ekran resmi ekleyeyim.
Abey bir kod buldum koddaki functionlara gerek kalmayacak galiba.Yani İl ve ilçeiçin numara aramaya gerek kalmayacak galiba.
Yani bir bekleyin dosyayı bitirince eklerim.
 
Yani alttaki kodla bayağı iyi olacak :)

Rich (BB code):
For Each objoption In .getElementById("cphMainSlider_solIcerik_ddlSehirler").Options
                    If LCase(Trim(objoption.innerText)) = LCase(Sayfa2.CbxSehir.Text) Then
                        .getElementById("cphMainSlider_solIcerik_ddlSehirler").Value = objoption.Value
                        .getElementById("cphMainSlider_solIcerik_ddlSehirler").Focus
                        .getElementById("cphMainSlider_solIcerik_ddlSehirler").FireEvent "onchange"
                        .getElementById("cphMainSlider_solIcerik_ddlSehirler").Click
                        Exit For
                    End If
                Next
 
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst