Soru Excelden web sayfasını kontrol etme ve veri çekme

[feridici_genc]

tüm herkese merhaba.

Maaş Hesaplama | Brütten Nete Maaş Hesaplama | Netten Brüte Maaş Hesaplama - Verginet

Brütten nete, netten brüte maaş hesaplama.

verginet.net

bu adreste ki tuşları ve kutucukları excel üzerinden doldurup oluşan rakamları excele aktarma imkanı var mı dostlar??

 

[Erdem Akdemir]

Aşağıdaki linkteki dosyayı hazırladım.

https://dosya.org/HexdW

Sub deneme()

Range("C6:O17").ClearContents
'Shell "taskkill /f /im iexplore*"
FindAndTerminate "IExplore.exe"
 Const MAX_WAIT_SEC As Long = 5

Dim ie As InternetExplorer

Set ie = CreateObject("InternetExplorer.Application")

URL = "https://verginet.net/maas-hesaplama.aspx"

ie.navigate URL
ie.Visible = False

    Do While ie.readyState <> READYSTATE_COMPLETE Or ie.Busy
    DoEvents
    Loop

'---------------------------------------------------------------------------------------------
  'Ücret tipi seçimi
    Set osma = ie.Document.createEvent("HTMLEvents")
    osma.initEvent "change", True, False
    Set aydi = ie.Document.getElementById("tip")
    aydi.selectedIndex = IIf(Range("B1").Text = "Brütten Nete", 0, 1)
    aydi.dispatchEvent osma

'---------------------------------------------------------------------------------------------
  'Yıl seçimi
    Set osma = ie.Document.createEvent("HTMLEvents")
    osma.initEvent "change", True, False
    Set aydi = ie.Document.getElementById("ctl00_ctl00_plBody_plBody_yil")
    deg = Application.Match(Range("B2").Text, Split(aydi.innertext, " "), 0) - 1
    aydi.selectedIndex = deg
    aydi.dispatchEvent osma
'---------------------------------------------------------------------------------------------
  'Medeni Durum
    Set osma = ie.Document.createEvent("HTMLEvents")
    osma.initEvent "change", True, False
    Set aydi = ie.Document.getElementById("martialTip")
    aydi.selectedIndex = IIf(Range("E1").Text = "Bekar", 0, 1)
    aydi.dispatchEvent osma
'---------------------------------------------------------------------------------------------
  'Eşi Çalışıyor mu ?
 
    If Range("E1").Text = "Bekar" And Range("E2").Text <> "" Then
    MsgBox "Medeni durumu bekar ise eş seçimi yapılamaz."
    ie.Quit
    Exit Sub
    End If
    
    If Range("E1").Text = "Evli" And Range("E2").Text = "" Then
    MsgBox "Eş çalışma durumunu seçiniz."
    ie.Quit
    Exit Sub

    End If
    
    If Range("E1").Text = "Evli" Then
    Set osma = ie.Document.createEvent("HTMLEvents")
    osma.initEvent "change", True, False
    Set aydi = ie.Document.getElementById("employStatus")
    aydi.selectedIndex = IIf(Range("E2").Text = "Çalışmıyor", 0, 1)
    aydi.dispatchEvent osma
    End If
'---------------------------------------------------------------------------------------------

  'Çocuk Sayısı
ie.Document.getElementById("childrenCount").Value = 5
ie.Document.getElementById("chkIsvrn").Value = 1

'---------------------------------------------------------------------------------------------
  'İşveren Maliyeti
    Set osma = ie.Document.createEvent("HTMLEvents")
    osma.initEvent "change", True, False
    Set aydi = ie.Document.getElementById("chkIsvrn")
    aydi.Checked = IIf(Range("H1").Text = "Ok", 1, 0)
    aydi.dispatchEvent osma
'---------------------------------------------------------------------------------------------
  'Sigorta primi işveren
    Set osma = ie.Document.createEvent("HTMLEvents")
    osma.initEvent "change", True, False
    Set aydi = ie.Document.getElementById("sgkDis")
    aydi.Checked = IIf(Range("H2").Text = "Ok", 1, 0)
    aydi.dispatchEvent osma
    
    For i = 1 To 12
    ie.Document.getElementById("m" & i).Value = Range("b" & i + 5).Text
    Next i
    
ie.Document.getElementById("btnHesapla").Click

'Set aaa = ie.Document.getElementsByClassName("btn btn-primary disabled")

basla = Timer: While (Timer - basla) < 1: Wend

 '----------------------------------------------------------------------------------------------------
'hesaplama

'Set bbb = ie.Document.getElementsByClassName("btn btn-primary")
'Set ccc = ie.Document.getElementsByClassName("btn btn-primary disabled")

        elapsedTime = Timer
        Do
        If ie.Document.getElementsByClassName("btn btn-primary disabled").Length = 0 Then Exit Do
        If Timer - elapsedTime > MAX_WAIT_SEC Then
            MsgBox "Bekleme süresini aştı..... kod sonlandırıldı!"
            GoTo SafeExit:
        End If
        Loop

Set Table = ie.Document.getElementsByTagName("Table")
Set Data = Table.Item(0).getElementsByTagName("tbody")

sat = 6
sut = 3

For Each satir In Data.Item(0).getElementsByTagName("tr")
        If sat = 18 Then Exit For

    For Each hucre In satir.Children

        If hucre.classname <> "tblMmonth" Then
         If IsNumeric(hucre.innertext) Then
  
            Cells(sat, sut) = CDbl(hucre.innertext)
            sut = sut + 1
        
         End If
        End If
    Next hucre
    sat = sat + 1
    sut = 3

Next satir

'
SafeExit:
ie.Quit

Set ie = Nothing
End Sub

Sub FindAndTerminate(ByVal strProcName As String)
    Dim objWMIService, objProcess, colProcess
    Dim strComputer, strList
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")
    Set colProcess = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = '" & strProcName & "'")
    If colProcess.Count > 0 Then
        For Each objProcess In colProcess
            objProcess.Terminate
        Next objProcess
    End If
End Sub