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

Excelismail · 2 Nis 2022

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.

Refaz · 2 Nis 2022

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

Refaz · 2 Nis 2022

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.

Excelismail · 2 Nis 2022

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.

Refaz · 2 Nis 2022

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.

Excelismail · 2 Nis 2022

İllerin merkezlerini baz alarak yapmaktayım.

Refaz · 3 Nis 2022

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.

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

Refaz · 3 Nis 2022

Bu dosyaya Numlock koduda eklendi.

Excelismail · 3 Nis 2022

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

Refaz · 3 Nis 2022

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.

Refaz · 3 Nis 2022

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.

Refaz · 3 Nis 2022

Refaz' Alıntı:
Sayfa2.Range("A2:A5,D250,E2:E50").ClearContents

Burdaki A2:A5 yerine A2:A50 olacaktı sıfır eklemeyi unutmuşum.
8.Mesajdaki dosya güncellendi.

Refaz · 3 Nis 2022

Abey.
Bugün biter dosya kopyalama,numlock ve extra sayfalara gerek kalmadı.
Gerekli ayarlamaları yapınca dosyayı eklerim.

Refaz · 3 Nis 2022

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

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

Excelismail · 3 Nis 2022

Sahurdan sonra illere 12 şer 12 şer değer verdim ama Aksaray’da kaldı. İl adını yazsamda hep Aksaray geldi.

Refaz · 3 Nis 2022

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.

Excelismail · 3 Nis 2022

Refaz,

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

Refaz · 3 Nis 2022

mehmetveliyy' Alıntı:
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.

Refaz · 3 Nis 2022

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

Excelismail · 3 Nis 2022

Beklerim. Sizin dediklerinizi yapayım yapabilecem diye uğraşayım dedim.

Foruma hoş geldin 👋 Ziyaretçi

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

Excelismail

Ekli dosyalar

muratboz06

Refaz

Refaz

Excelismail

Refaz,

Refaz

Excelismail

Refaz

Ekli dosyalar

Refaz

Ekli dosyalar

Excelismail

Refaz,

Refaz

Refaz

Refaz

Refaz

Refaz

Ekli dosyalar

Excelismail

Refaz

Excelismail

Refaz,

Ekli dosyalar

Refaz

Refaz,

Refaz

Excelismail

Foruma hoş geldin 👋 Ziyaretçi

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

Ekli dosyalar

Refaz,​

Ekli dosyalar

Ekli dosyalar

Refaz,​

Ekli dosyalar

Refaz,​

Ekli dosyalar

Refaz,​

Refaz,

Refaz,

Refaz,

Refaz,