• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kodlama düzeltmek

Katılım
7 Eylül 2008
Mesajlar
76
Excel Vers. ve Dili
yok
aşagıdaki kodla a2 hücresine şirketiçi protokol noyu girdiğimizde butona tıkladığımda sonucu b2 c2...j2 veriyi yüklüyor
buraya kadar herşey güzel
benim istediğim a3 hücresine şirketiçi protokol noyu girdiğimizde butona bastığım zaman verileri b3 c3...... j3 yüklesin

yani a2 hücresinden a200 hücresine kadar şirketiçi protokol noyu girdiğimizde
butona tıkladığımız zaman sırayla bütün verileri sıralamasını istiyorum

yardım ederseniz sevinirim

Sub sirket()
Dim evn As Object, link As String
On Local Error Resume Next
link = "http://......................aspx"
For i = vbCancel To CInt(Chr(50))
20 Set evn = CreateObject("internetexplorer.application")
evn.navigate link
Do While evn.busy: Loop
Do Until evn.readystate = 4: Loop
With evn.document.all
Do While evn.busy: Loop
.txtprotokolno.Value = Sheets("Sayfa1").Cells(i, 1).Value
.ddlAlan.Value = 4930
.ddlAtamaTuru.Value = 1
.chkOkudum.Checked = True
.submit.Click

End With
10 With evn
If evn Is Nothing Then GoTo 20
Do While .busy: Loop
Do Until .readystate = 4: Loop
With .document.all
Sheets("sayfa1").Cells(i, 2).Value = .Item(171).innertext
Sheets("sayfa1").Cells(i, 3).Value = .Item(194).innertext
Sheets("sayfa1").Cells(i, 4).Value = .Item(216).innertext
Sheets("sayfa1").Cells(i, 5).Value = .Item(239).innertext
Sheets("sayfa1").Cells(i, 6).Value = .Item(245).innertext
Sheets("sayfa1").Cells(i, 7).Value = .Item(265).innertext
Sheets("sayfa1").Cells(i, 8).Value = .Item(271).innertext
Sheets("sayfa1").Cells(i, 9).Value = .Item(289).innertext
Sheets("sayfa1").Cells(i, 10).Value = .Item(295).innertext
If Err Then
Err.Clear
Application.Wait Now + TimeSerial(0, 0, 2)
GoTo 10
End If
End With
.Quit
End With
Set evn = Nothing
Next i
link = vbNullString
End Sub
 
Geri
Üst