'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