Makrodaki aşamaların hızı hakkında

[harziyan]

Merhabalar; aşağıdaki makrodaki kırmızı işaretli kısmı 2 ayrı butonla çalıştırdığımda herhangi bir sorun yaşamazken, işlemi daha hızlandırmak için kodları art arda sıraladığımda bu kırmızı alan -makronun hızından mı bilemedim ama- fonksiyonsuz kalıyor. Buradaki kodlar bi şekilde atlanıyor gibi! Forumda bulduğum yavaşlatma kodunu uygulamadım ama nafile, kırmızı alanda hız düştü ama focus ve sendkeys yine atlandı. hemen "click" satırı çalıştı.

Sub Yavas_Yaz()
    Sleep (200)
End Sub
Private Sub CommandButton5_Click()

    Do
        Sheets("Sorgu").Rows("2:2").Delete
    
        Sheets("web").Select
        Range("A1").Select
        
        Dim tbl As Object, tr As Object, td As Object, j As Integer
                
                Set Rky = WebBrowser1.Document.getElementsByTagName("ctl00_ctl00_bodyCPH_ContentPlaceHolder1_grdList_ctl00__0")
                For Each tbl In Rky
                    For Each tr In tbl.Rows
                        For Each td In tr.Cells
                            Cells(son + 1, j + 1) = td.innerText
                            j = j + 1
                        Next td
                        son = son + 1: j = 0
                    Next tr
                    son = son + 1
             Next tbl
        
        Sheets("web").Range("A15:p15").Cut
        Sheets("Nufus").Select
        SAT = Cells(65536, "A").End(3).Row + 1
        Cells(SAT, 1).Select
        ActiveSheet.Paste
        
[COLOR="Red"]        Yavas_Yaz
WebBrowser1.Document.getelementbyid("ctl00_ctl00_bodyCPH_ContentPlaceHolder1_edtIdNo").Focus
        Yavas_Yaz
        SendKeys Sheets("SORGU").[a2], True
        Yavas_Yaz[/COLOR]
        WebBrowser1.Document.All.Item("bodyCPH_ContentPlaceHolder1_btnMernis").Click
    Loop

End Sub

Başka bir sorun da "click" olayından sonra webbrowserda "lütfen bekleyin" diye bir popup benzeri küçük ekran çıkıyor. Onu da aşağıdaki yöntemle beklemeye çalışıyorum,başka sitelerde çalışan bu satırlar, ekran "popup" olduğundan mı bilmem işe yaramıyor. Çözüm önerisi olan var mı acaba?

Do While WebBrowser1.Busy: DoEvents: Loop
Do While WebBrowser1.ReadyState <> 4: DoEvents: Loop

Bu da ilgili "Lütfen Bekleyin" uyarısının kaynak kodu;

<div unselectable="on" style="width: 280px; height: 118px; position: absolute; visibility: hidden; left: 499px; top: 162px; z-index: 1000000; display: none;" class="RadWindow RadWindow_Metro rwNormalWindow rwTransparentWindow rwShadow" id="RadWindowWrapper_ctl00_ctl00_Wloading"><table style="height: 115px;" class="rwTable rwShadow" cellpadding="0" cellspacing="0"><tbody><tr class="rwTitleRow"><td class="rwCorner rwTopLeft"> </td><td class="rwTitlebar"><div class="rwTopResize"><!-- / --></div><table class="rwTitlebarControls" align="left" cellpadding="0" cellspacing="0"><tbody><tr><td style="width: 16px;"><a tabindex="0" class="rwIcon"></a></td><td><em style="width: 1px;" unselectable="on">YÜKLENİYOR...</em></td><td style="white-space: nowrap;" nowrap=""><ul class="rwControlButtons"></ul></td></tr></tbody></table></td><td class="rwCorner rwTopRight"> </td></tr><tr class="rwContentRow"><td class="rwCorner rwBodyLeft"> </td><td class="rwWindowContent" valign="top"><div style="overflow: hidden; border: 0px none; width: 250px; height: 69px;" id="ctl00_ctl00_Wloading_C">
		
                    <center>
                        <br>                  
                        <img id="ctl00_ctl00_Wloading_C_myLoadingImg" src="../../images/loading11.gif"><br>
                        <span style="font-family:Tahoma; font-size:11px; color:black;">İşleminiz gerçekleştiriliyor. Lütfen Bekleyiniz...</span>
                   </center>
                
	</div></td><td class="rwCorner rwBodyRight"> </td></tr><tr style="display: none;" class="rwStatusbarRow"><td class="rwCorner rwBodyLeft"> </td><td class="rwStatusbar"><table style="width: 100%;" align="left" cellpadding="0" cellspacing="0"><tbody><tr><td style="width: 100%;"><input tabindex="0" unselectable="on" readonly="" id="ctl00_ctl00_Wloading_status"><label style="display: none;" for="ctl00_ctl00_Wloading_status">status label</label></td></tr></tbody></table></td><td class="rwCorner rwBodyRight"> </td></tr><tr class="rwFooterRow"><td class="rwCorner rwFooterLeft"> </td><td class="rwFooterCenter"> </td><td class="rwCorner rwFooterRight"> </td></tr></tbody></table></div>

 

[Ömer]

Merhaba,

Aşağıdaki satırı atlananan bölümlerden önce ilave ediniz. Bekleme süresini 1 saniye olarak belirledim. Siz işleme göre artırabilirsiniz.

Application.Wait (Now() + TimeValue("00:00:01"))

.

 

[harziyan]

İşe yaramadı Ömer Hocam!

 

[Zeki Gürsoy]

Kırmızı olan alan için aşağıdaki yapıyı yapıştırarak çalıştırmayı deneyin.

do
        doevents
        Set obj = WebBrowser1.Document.getelementbyid("ctl00_ctl00_bodyCPH_ContentPlaceHolder1_edtIdNo")
        if not obj is nothing then exit do
        loop

        obj.Focus

        SendKeys Sheets("SORGU").[a2], True

        do
        doevents
        set obj2 = WebBrowser1.Document.All.Item("bodyCPH_ContentPlaceHolder1_btnMernis")
        if not obj2 is nothing then exit do
        loop

        obj2.Click